1 Vergleich von Klassifikationsmethoden in simulierten Fragebogen-Daten


Vergleich von Methoden zur Veränderungsklassifikation in simulierten Fragebogen-Daten für verschiedene Messzeitpunkt-Intervalle:

“PP_5.5” besteht aus je 5 Messzeitpunkten im Pre- und im Post-Intervall. Dies sind die ursprünglich simulierten Fragebogen-Daten von N = 8226 Personen (ursprünglich N = 100.000).

“PP_30.30” besteht aus je 30 Messzeitpunkten im Pre- und im Post-Intervall. Diese wurden aus den ursprünglichen Simulationsdaten erweitert und umfassen dieselben N = 8226 Personen.

“PP_1.1” besteht jeweils aus dem 1. Messzeitpunkt im Pre- und im Post-Intervall für jede einzelne Person (N = 8226).

# Ausschluss von Personen ohne Varianz in min. einem MZP-Intervall

PP_5.5 = PP_5.5 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)

PP_30.30 = PP_30.30 %>% 
  filter(ind.pretestSD != 0 & ind.posttestSD != 0)


PP_5.5 = PP_5.5 %>% 
  filter(ID_orig %in% PP_30.30$ID1_PRE)

PP_30.30 = PP_30.30 %>% 
  filter(ID1_PRE %in% PP_5.5$ID_orig)

PP_1.1 = PP_1.1 %>% 
  filter(ID_orig %in% PP_5.5$ID_orig & ID_orig %in% PP_30.30$ID1_PRE)


PP_5.5 = PP_5.5 %>% 
  add_column(., .before = "ID_orig", ID = 1:nrow(.))

PP_30.30 = PP_30.30 %>% 
  add_column(., .before = "ID1_PRE", ID = 1:nrow(.))

PP_1.1 = PP_1.1 %>% 
  add_column(., .before = "ID_orig", ID = 1:nrow(.))

1.1 Überblick über die simulierten Daten

Beispiel-Verläufe in den 3 untersuchten Datensets

1.1.1 Original-Simulationsdaten (je 5 MZP)

PP_5.5 %>%
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID ID_orig PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 1 8 7 11 8 7 1 2 1 4 7 8.2 3.0 5.2 1.64 2.55
2 2 9 10 11 11 11 13 13 8 12 6 10.4 10.4 0.0 0.89 3.21
3 3 8 8 10 11 8 1 2 3 2 2 9.0 2.0 7.0 1.41 0.71
4 4 10 7 8 5 6 6 5 4 3 1 7.2 3.8 3.4 1.92 1.92
5 5 9 6 4 7 9 6 6 7 4 9 7.0 6.4 0.6 2.12 1.82
6 6 12 13 11 10 19 11 10 7 7 6 13.0 8.2 4.8 3.54 2.17


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_5.5$ID, 9)

x = tibble(ID = c(rep(rand[1],times=11),
                  rep(rand[2],times=11),
                  rep(rand[3],times=11),
                  rep(rand[4],times=11),
                  rep(rand[5],times=11),
                  rep(rand[6],times=11),
                  rep(rand[7],times=11),
                  rep(rand[8],times=11),
                  rep(rand[9],times=11)),
           MZP = rep(seq(as.Date("2020-01-01"), length.out=11, by="1 day"), times=9),
           Score = c(as.numeric(PP_5.5[rand[1],pre_5mzp]), NA, as.numeric(PP_5.5[rand[1],post_5mzp]),
                     as.numeric(PP_5.5[rand[2],pre_5mzp]), NA, as.numeric(PP_5.5[rand[2],post_5mzp]),
                     as.numeric(PP_5.5[rand[3],pre_5mzp]), NA, as.numeric(PP_5.5[rand[3],post_5mzp]),
                     as.numeric(PP_5.5[rand[4],pre_5mzp]), NA, as.numeric(PP_5.5[rand[4],post_5mzp]),
                     as.numeric(PP_5.5[rand[5],pre_5mzp]), NA, as.numeric(PP_5.5[rand[5],post_5mzp]),
                     as.numeric(PP_5.5[rand[6],pre_5mzp]), NA, as.numeric(PP_5.5[rand[6],post_5mzp]),
                     as.numeric(PP_5.5[rand[7],pre_5mzp]), NA, as.numeric(PP_5.5[rand[7],post_5mzp]),
                     as.numeric(PP_5.5[rand[8],pre_5mzp]), NA, as.numeric(PP_5.5[rand[8],post_5mzp]),
                     as.numeric(PP_5.5[rand[9],pre_5mzp]), NA, as.numeric(PP_5.5[rand[9],post_5mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_5.5
# converting my dataframes to use in the same ggplot structure:
PP_5.5_ts = PP_5.5 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(PP_5.5)))

save(PP_5.5_ts, file = "Time Series Dataframes/k20_PP_5.5_ts.RData")

###

load("Time Series Dataframes/k20_PP_5.5_ts.RData")

# Repeated measures with box− and violin plots
PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_5.5_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_5.5_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_5.5))
score_se_2 = score_sd_2/sqrt(nrow(PP_5.5))
score_ci_1 = PP_5.5_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_5.5_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_5.5), nrow(PP_5.5))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c(as.numeric(score_ci_1[1] - score_ci_1[3]), as.numeric(score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_5.5_ts$jit = jitter(PP_5.5_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_5.5_ts, aes(y = Mean)) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_5.5_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_5.5_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (5+5 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_5.5_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_5.5_Pre-Post_Box_Violin_Mean+CI.jpg")


1.1.2 Erweiterte Intervall-Daten (je 30 MZP)

PP_30.30 %>% 
  select(-(ID1_PRE:ID6_POST)) %>% 
  within(., {ind.pretestSD = round(ind.pretestSD, digits = 2)
            ind.posttestSD = round(ind.posttestSD, digits = 2)}) %>% 
  head() %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE) %>% 
  scroll_box(width = "100%")
ID PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 PRE1_6 PRE1_7 PRE1_8 PRE1_9 PRE1_10 PRE1_11 PRE1_12 PRE1_13 PRE1_14 PRE1_15 PRE1_16 PRE1_17 PRE1_18 PRE1_19 PRE1_20 PRE1_21 PRE1_22 PRE1_23 PRE1_24 PRE1_25 PRE1_26 PRE1_27 PRE1_28 PRE1_29 PRE1_30 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 POST1_6 POST1_7 POST1_8 POST1_9 POST1_10 POST1_11 POST1_12 POST1_13 POST1_14 POST1_15 POST1_16 POST1_17 POST1_18 POST1_19 POST1_20 POST1_21 POST1_22 POST1_23 POST1_24 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 POST1_30 PRE_Mean POST_Mean MeanDiff ind.pretestSD ind.posttestSD
1 8 7 11 8 7 7 10 10 7 7 9 9 6 7 10 9 7 9 10 6 7 7 10 10 7 11 8 8 7 7 1 2 1 4 7 7 4 1 1 2 7 1 1 2 4 2 1 1 4 7 1 1 2 4 7 1 4 2 1 7 8.2 3.0 5.2 1.49 2.32
2 9 10 11 11 11 11 11 9 10 11 10 12 10 10 10 10 11 11 11 9 10 11 11 11 9 11 10 11 11 9 13 13 8 12 6 6 14 13 10 9 11 10 10 6 15 14 13 9 10 6 6 9 13 14 10 6 10 9 14 13 10.4 10.4 0.0 0.81 2.92
3 8 8 10 11 8 10 10 8 7 10 7 9 9 9 11 11 7 9 9 9 11 7 9 9 9 10 7 10 10 8 1 2 3 2 2 2 1 2 3 2 2 2 2 3 1 1 2 3 2 2 3 2 1 2 2 2 2 2 3 1 9.0 2.0 7.0 1.29 0.64
4 10 7 8 5 6 6 8 10 7 5 9 7 8 4 8 9 7 8 8 4 7 9 8 8 4 10 5 6 8 7 6 5 4 3 1 7 4 3 3 2 4 3 1 5 6 5 6 3 4 1 4 3 1 6 5 6 4 5 3 1 7.2 3.8 3.4 1.75 1.75
5 9 6 4 7 9 7 9 4 6 9 10 7 5 8 5 5 5 8 7 10 6 9 4 7 9 5 5 8 10 7 6 6 7 4 9 6 4 7 9 6 8 5 4 7 8 7 8 8 5 4 4 5 7 8 8 7 8 8 4 5 7.0 6.4 0.6 1.93 1.65
6 12 13 11 10 19 16 7 14 13 15 10 11 13 12 19 18 15 12 11 9 19 13 12 10 11 11 12 10 13 19 11 10 7 7 6 11 10 7 7 6 7 7 12 8 7 11 8 5 9 8 11 6 10 7 7 10 9 5 10 7 13.0 8.2 4.8 3.22 1.97


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_30.30$ID, 9)

x = tibble(ID = c(rep(rand[1],times=61),
                     rep(rand[2],times=61),
                     rep(rand[3],times=61),
                     rep(rand[4],times=61),
                     rep(rand[5],times=61),
                     rep(rand[6],times=61),
                     rep(rand[7],times=61),
                     rep(rand[8],times=61),
                     rep(rand[9],times=61)),
              MZP = rep(seq(as.Date("2020-01-01"), length.out=61, by="1 day"), times=9),
              Score = c(as.numeric(PP_30.30[rand[1],pre_30mzp]), NA, as.numeric(PP_30.30[rand[1],post_30mzp]),
                        as.numeric(PP_30.30[rand[2],pre_30mzp]), NA, as.numeric(PP_30.30[rand[2],post_30mzp]),
                        as.numeric(PP_30.30[rand[3],pre_30mzp]), NA, as.numeric(PP_30.30[rand[3],post_30mzp]),
                        as.numeric(PP_30.30[rand[4],pre_30mzp]), NA, as.numeric(PP_30.30[rand[4],post_30mzp]),
                        as.numeric(PP_30.30[rand[5],pre_30mzp]), NA, as.numeric(PP_30.30[rand[5],post_30mzp]),
                        as.numeric(PP_30.30[rand[6],pre_30mzp]), NA, as.numeric(PP_30.30[rand[6],post_30mzp]),
                        as.numeric(PP_30.30[rand[7],pre_30mzp]), NA, as.numeric(PP_30.30[rand[7],post_30mzp]),
                        as.numeric(PP_30.30[rand[8],pre_30mzp]), NA, as.numeric(PP_30.30[rand[8],post_30mzp]),
                        as.numeric(PP_30.30[rand[9],pre_30mzp]), NA, as.numeric(PP_30.30[rand[9],post_30mzp])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_30.30
# converting my dataframes to use in the same ggplot structure:
PP_30.30_ts = PP_30.30 %>% 
  select(ID, PRE_Mean, POST_Mean) %>% 
  pivot_longer(!ID, names_to = "Interval", values_to = "Mean") %>% 
  mutate(ID = as.factor(ID),
         Interval = rep(c(1,2), times = nrow(PP_30.30)))

save(PP_30.30_ts, file = "Time Series Dataframes/k20_PP_30.30_ts.RData")

###

load("Time Series Dataframes/k20_PP_30.30_ts.RData")

# Repeated measures with box− and violin plots
PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(mean(Mean)) %>% as.numeric()
score_mean_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(mean(Mean)) %>% as.numeric()
score_median1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(median(Mean)) %>% as.numeric()
score_median2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(median(Mean)) %>% as.numeric()
score_sd_1 = PP_30.30_ts %>% filter(Interval == "1") %>% summarise(sd(Mean)) %>% as.numeric()
score_sd_2 = PP_30.30_ts %>% filter(Interval == "2") %>% summarise(sd(Mean)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_30.30))
score_se_2 = score_sd_2/sqrt(nrow(PP_30.30))
score_ci_1 = PP_30.30_ts %>% filter(Interval == "1") %>% pull(Mean) %>% CI(., ci = 0.95)
score_ci_2 = PP_30.30_ts %>% filter(Interval == "2") %>% pull(Mean) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_30.30), nrow(PP_30.30))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_30.30_ts$jit = jitter(PP_30.30_ts$Interval, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_30.30_ts, aes(y = Mean)) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = Mean), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = Mean), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_30.30_ts %>% filter(Interval == "2"),aes(x = Interval, y = Mean), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "1"), aes(x = Interval, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_30.30_ts %>% filter(Interval == "2"), aes(x = Interval, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Interval") + ylab("PHQ-9 Mean Score") +
  #ggtitle("Paper-Pencil Data (30+30 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_30.30_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_30.30_Pre-Post_Box_Violin_Mean+CI.jpg")


1.1.3 Stichprobe mit je 1 MZP

kable(head(PP_1.1)) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
ID ID_orig PRE POST Diff
1 1 8 1 7
2 2 9 13 -4
3 3 8 1 7
4 4 10 6 4
5 5 9 6 3
6 6 12 11 1


Pre-Post-Verläufe für 9 zufällig gezogene Personen

rand = sample(PP_1.1$ID, 9)

x = tibble(ID = c(rep(rand[1],times=3),
                     rep(rand[2],times=3),
                     rep(rand[3],times=3),
                     rep(rand[4],times=3),
                     rep(rand[5],times=3),
                     rep(rand[6],times=3),
                     rep(rand[7],times=3),
                     rep(rand[8],times=3),
                     rep(rand[9],times=3)),
              MZP = rep(seq(as.Date("2020-01-01"), length.out=3, by="1 day"), times=9),
              Score = c(as.numeric(PP_1.1[rand[1],"PRE"]), NA, as.numeric(PP_1.1[rand[1],"POST"]),
                        as.numeric(PP_1.1[rand[2],"PRE"]), NA, as.numeric(PP_1.1[rand[2],"POST"]),
                        as.numeric(PP_1.1[rand[3],"PRE"]), NA, as.numeric(PP_1.1[rand[3],"POST"]),
                        as.numeric(PP_1.1[rand[4],"PRE"]), NA, as.numeric(PP_1.1[rand[4],"POST"]),
                        as.numeric(PP_1.1[rand[5],"PRE"]), NA, as.numeric(PP_1.1[rand[5],"POST"]),
                        as.numeric(PP_1.1[rand[6],"PRE"]), NA, as.numeric(PP_1.1[rand[6],"POST"]),
                        as.numeric(PP_1.1[rand[7],"PRE"]), NA, as.numeric(PP_1.1[rand[7],"POST"]),
                        as.numeric(PP_1.1[rand[8],"PRE"]), NA, as.numeric(PP_1.1[rand[8],"POST"]),
                        as.numeric(PP_1.1[rand[9],"PRE"]), NA, as.numeric(PP_1.1[rand[9],"POST"])))

x %>%
  group_by(ID) %>% 
  plot_time_series(MZP, Score,
    #.color_var = ID,           # for multiple lines in one plot
    #.color_lab = "ID",
    .facet_ncol = 3,
    .facet_scales = "fixed",
    .interactive = TRUE,
    .facet_collapse = FALSE,
    .smooth = TRUE,
    .smooth_degree = 2,
    .smooth_alpha = 0.5,
    .smooth_size = 0.2
  )
# don´t run this section (code for extremely computation-intense plots that I already stored as .RData and .jpg)
# repeated-measures scatter-boxplot-violin-histograms for individual PRE and POST means
# from van Langen (2020) Open-visualizations tutorial for repeated measures in R

# PP_1.1
# converting my dataframes to use in the same ggplot structure:
PP_1.1_ts = PP_1.1 %>% 
  select(ID, PRE, POST) %>% 
  pivot_longer(!ID, names_to = "Timepoint", values_to = "Score") %>% 
  mutate(ID = as.factor(ID),
         Timepoint = rep(c(1,2), times = nrow(PP_1.1)))

save(PP_1.1_ts, file = "Time Series Dataframes/k20_PP_1.1_ts.RData")

###

load("Time Series Dataframes/k20_PP_1.1_ts.RData")

# Repeated measures with box− and violin plots
PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09)

Pre_Post_Box_Violin = ggplot(data = PP_1.1_ts, aes(y = Score)) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .5) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .5) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.25),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "dodgerblue", alpha = .5) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .15),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = TRUE, width = .1,
    fill = "darkorange", alpha = .5) +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = 1.3),
    side = "r", fill = "dodgerblue", alpha = .5, trim = FALSE) +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
    side = "r", fill = "darkorange", alpha = .5, trim = FALSE) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Single Assessment") + ylab("PHQ-9 Score") +
  #ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg", plot = Pre_Post_Box_Violin, width = 6, height = 4)
save(Pre_Post_Box_Violin, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin.RData")


# Repeated measures with box− and violin plots and means + CIs
score_mean_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(mean(Score)) %>% as.numeric()
score_mean_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(mean(Score)) %>% as.numeric()
score_median1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(median(Score)) %>% as.numeric()
score_median2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(median(Score)) %>% as.numeric()
score_sd_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% summarise(sd(Score)) %>% as.numeric()
score_sd_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% summarise(sd(Score)) %>% as.numeric()
score_se_1 = score_sd_1/sqrt(nrow(PP_1.1))
score_se_2 = score_sd_2/sqrt(nrow(PP_1.1))
score_ci_1 = PP_1.1_ts %>% filter(Timepoint == "1") %>% pull(Score) %>% CI(., ci = 0.95)
score_ci_2 = PP_1.1_ts %>% filter(Timepoint == "2") %>% pull(Score) %>% CI(., ci = 0.95)
#Create data frame with 2 rows and 7 columns containing the descriptives
group = c("PRE", "POST")
N = c(nrow(PP_1.1), nrow(PP_1.1))
score_mean = c(score_mean_1, score_mean_2)
score_median = c(score_median1, score_median2)
sd = c(score_sd_1, score_sd_2)
se = c(score_se_1, score_se_2)
ci = c((score_ci_1[1] - score_ci_1[3]), (score_ci_2[1] - score_ci_2[3]))
summary_df = data.frame(group, N, score_mean, score_median, sd, se, ci)

# PP_1.1_ts$jit = jitter(PP_1.1_ts$Timepoint, amount = .09)     #already created above
x_tick_means = c(.87, 2.13)

Pre_Post_Box_Violin_Mean_CI = ggplot(data = PP_1.1_ts, aes(y = Score)) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = jit), color = "dodgerblue", size = 1,
             alpha = .6) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = jit), color = "darkorange", size = 1,
             alpha = .6) +
  geom_line(aes(x = jit, group = ID), color = "lightgray", alpha = .05) +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.28),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "dodgerblue") +
  geom_half_boxplot(
    data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = Score), position = position_nudge(x = .18),
    side = "r", outlier.shape = NA, center = TRUE, errorbar.draw = FALSE, width = .2,
    fill = "darkorange") +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = Score), position = position_nudge(x = -.3),
    side = "l", fill = "dodgerblue") +
  geom_half_violin(
    data = PP_1.1_ts %>% filter(Timepoint == "2"),aes(x = Timepoint, y = Score), position = position_nudge(x = .3),
    side = "r", fill = "darkorange") +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1]),
             position = position_nudge(x = -.13), color = "dodgerblue", alpha = .6, size = 1.5) +
  geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "1"), aes(x = Timepoint, y = score_mean[1],
                                                 ymin = score_mean[1]-ci[1], ymax = score_mean[1]+ci[1]),
                position = position_nudge(-.13), color = "dodgerblue", width = 0.05, size = 0.4, alpha = .6) +
  geom_point(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2]),
             position = position_nudge(x = .13), color = "darkorange", alpha = .6, size = 1.5)+
  geom_errorbar(data = PP_1.1_ts %>% filter(Timepoint == "2"), aes(x = Timepoint, y = score_mean[2],
                                                 ymin = score_mean[2]-ci[2], ymax = score_mean[2]+ci[2]), 
                position = position_nudge(.13), color = "darkorange", width = 0.05, size = 0.4, alpha = .6) +
  geom_line(data = summary_df, aes(x = x_tick_means, y = score_mean), color = "gray", size = 1) +
  scale_x_continuous(breaks = c(1,2), labels = c("PRE", "POST"), limits = c(0, 3)) +
  xlab("Single Assessment") + ylab("PHQ-9 Score") +
  #ggtitle("Paper-Pencil Data (1+1 Timepoints): Individual Pre-Post Means") +
  #theme_classic() +
  theme_bw() +
  coord_cartesian(ylim = c(0, 24))

ggsave("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg", plot = Pre_Post_Box_Violin_Mean_CI, width = 6, height = 4)
save(Pre_Post_Box_Violin_Mean_CI, file = "Time Series Dataframes/k20_PP_1.1_Pre_Post_Box_Violin_Mean_CI.RData")
#knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin.jpg")
knitr::include_graphics("Time Series Dataframes/k20_PP_1.1_Pre-Post_Box_Violin_Mean+CI.jpg")


1.2 Deskriptive Statistiken der Datensets

tibble(Descriptives = c("mean_PRE_Mean","mean_POST_Mean","mean_MeanDiff","mean_PRE_1MZP","mean_POST_1MZP",
                        "mean_Diff_1MZP","mean_ind.pretestSD","mean_ind.posttestSD","sd_PRE_1MZP","sd_POST_1MZP"),
       PP_5.5 = round(c(mean(PP_5.5$PRE_Mean),mean(PP_5.5$POST_Mean),mean(PP_5.5$MeanDiff),NA,NA,NA,
                       mean(PP_5.5$ind.pretestSD),mean(PP_5.5$ind.posttestSD),NA,NA), digits = 3),
       PP_30.30 = round(c(mean(PP_30.30$PRE_Mean),mean(PP_30.30$POST_Mean),mean(PP_30.30$MeanDiff),
                         NA,NA,NA,mean(PP_30.30$ind.pretestSD),mean(PP_30.30$ind.posttestSD),NA,NA), digits = 3),
       PP_1.1 = round(c(NA,NA,NA,mean(PP_1.1$PRE),mean(PP_1.1$POST),mean(PP_1.1$Diff),
                          NA,NA,sd(PP_1.1$PRE),sd(PP_1.1$POST)), digits = 3)) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Descriptives PP_5.5 PP_30.30 PP_1.1
mean_PRE_Mean 10.335 10.335 NA
mean_POST_Mean 7.077 7.077 NA
mean_MeanDiff 3.258 3.258 NA
mean_PRE_1MZP NA NA 10.321
mean_POST_1MZP NA NA 7.036
mean_Diff_1MZP NA NA 3.286
mean_ind.pretestSD 2.047 1.862 NA
mean_ind.posttestSD 2.531 2.302 NA
sd_PRE_1MZP NA NA 3.196
sd_POST_1MZP NA NA 3.941

Boxplots der Pre- und Post-(Mittel-)Werte

# Boxplots zum Vergleich
temp = tibble(Scores = c(PP_5.5$PRE_Mean, PP_30.30$PRE_Mean, PP_1.1$PRE), 
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$PRE_Mean)))

ggplot(temp, aes(x = Datasets, y = Scores)) + 
  geom_boxplot() + 
  ylim(0, 27) +
  ggtitle("PHQ-9 PRE(-Mean)") +
  xlab("Dataset") +
  ylab("PHQ-9 Scores")

temp = tibble(Scores = c(PP_5.5$POST_Mean, PP_30.30$POST_Mean, PP_1.1$POST), 
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$POST_Mean)))

ggplot(temp, aes(x = Datasets, y = Scores)) + 
  geom_boxplot() + 
  ylim(0, 27) +
  ggtitle("PHQ-9 POST(-Mean)") +
  xlab("Dataset") +
  ylab("PHQ-9 Scores")

Prozentuale Überlappung der Pre-(Mittel-)Werte

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_30.30_PRE_Mean = PP_30.30$PRE_Mean))$OV)

final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)

final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE), 
           overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_1.1_PRE = PP_1.1$PRE))$OV)

Prozentuale Überlappung der Post-(Mittel-)Werte

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean), 
           overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_30MZP_POST_Mean = PP_30.30$POST_Mean))$OV)

final.plot(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_5.5_POST_Mean = PP_5.5$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)

final.plot(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_30MZP_POST_Mean = PP_30.30$POST_Mean, PP_1.1_POST = PP_1.1$POST))$OV)


1.3 Reliabilitäten und Inter-Item-Korrelationen

1.3.1 PP_5.5 (je 5 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
PP_5.5_KorMat = cor(PP_5.5[, c(pre_5mzp, post_5mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:4) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 4)

post_inter_item_rtt = 0L
for (i in 5:9) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_5.5_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 4)


for (i in 1:9) {
  PP_5.5_KorMat[i, i+1] = cell_spec(PP_5.5_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(PP_5.5_KorMat) = cell_spec(rownames(PP_5.5_KorMat), "html", bold = TRUE)

PP_5.5_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T)
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5
PRE1_1 1 0.67 0.49 0.37 0.29 0.34 0.22 0.16 0.12 0.09
PRE1_2 0.67 1 0.68 0.5 0.38 0.23 0.15 0.11 0.09 0.07
PRE1_3 0.49 0.68 1 0.68 0.49 0.17 0.11 0.09 0.07 0.05
PRE1_4 0.37 0.5 0.68 1 0.67 0.13 0.08 0.06 0.06 0.04
PRE1_5 0.29 0.38 0.49 0.67 1 0.1 0.06 0.07 0.05 0.03
POST1_1 0.34 0.23 0.17 0.13 0.1 1 0.66 0.48 0.36 0.28
POST1_2 0.22 0.15 0.11 0.08 0.06 0.66 1 0.67 0.49 0.37
POST1_3 0.16 0.11 0.09 0.06 0.07 0.48 0.67 1 0.68 0.48
POST1_4 0.12 0.09 0.07 0.06 0.05 0.36 0.49 0.68 1 0.66
POST1_5 0.09 0.07 0.05 0.04 0.03 0.28 0.37 0.48 0.66 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_5.5[pre_5mzp])
POST_alpha = CronbachAlpha(PP_5.5[post_5mzp])
PP_5.5_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.68.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.68.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.843.


1.3.2 PP_30.30 (je 30 MZP)

# Korrelationsmatrix von PRE- und POST-MZP:
PP_30.30_KorMat = cor(PP_30.30[, c(pre_30mzp, post_30mzp)]) %>% 
  round(., digits = 2)

# durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden MZP (Fisher-Z-transformiert):
pre_inter_item_rtt = 0L
for (i in 1:29) {
  pre_inter_item_rtt = pre_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
pre_inter_item_rtt = FisherZInv(pre_inter_item_rtt / 29)

post_inter_item_rtt = 0L
for (i in 31:59) {
  post_inter_item_rtt = post_inter_item_rtt + FisherZ(PP_30.30_KorMat[i,i+1])
}
post_inter_item_rtt = FisherZInv(post_inter_item_rtt / 29)


for (i in 1:59) {
  PP_30.30_KorMat[i, i+1] = cell_spec(PP_30.30_KorMat[i, i+1], "html", bold = TRUE)
}

rownames(PP_30.30_KorMat) = cell_spec(rownames(PP_30.30_KorMat), "html", bold = TRUE)

PP_30.30_KorMat %>%
  kable(., format = "html", escape = FALSE) %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE, fixed_thead = T) %>%
  scroll_box(height = "800px")
PRE1_1 PRE1_2 PRE1_3 PRE1_4 PRE1_5 PRE1_6 PRE1_7 PRE1_8 PRE1_9 PRE1_10 PRE1_11 PRE1_12 PRE1_13 PRE1_14 PRE1_15 PRE1_16 PRE1_17 PRE1_18 PRE1_19 PRE1_20 PRE1_21 PRE1_22 PRE1_23 PRE1_24 PRE1_25 PRE1_26 PRE1_27 PRE1_28 PRE1_29 PRE1_30 POST1_1 POST1_2 POST1_3 POST1_4 POST1_5 POST1_6 POST1_7 POST1_8 POST1_9 POST1_10 POST1_11 POST1_12 POST1_13 POST1_14 POST1_15 POST1_16 POST1_17 POST1_18 POST1_19 POST1_20 POST1_21 POST1_22 POST1_23 POST1_24 POST1_25 POST1_26 POST1_27 POST1_28 POST1_29 POST1_30
PRE1_1 1 0.67 0.49 0.37 0.29 0.51 0.58 0.6 0.59 0.53 0.51 0.59 0.61 0.59 0.51 0.54 0.58 0.6 0.58 0.51 0.53 0.59 0.6 0.58 0.52 0.5 0.59 0.61 0.58 0.53 0.34 0.22 0.16 0.12 0.09 0.16 0.2 0.2 0.2 0.17 0.18 0.19 0.19 0.19 0.18 0.15 0.19 0.21 0.2 0.18 0.17 0.2 0.2 0.19 0.17 0.18 0.2 0.2 0.19 0.16
PRE1_2 0.67 1 0.68 0.5 0.38 0.59 0.67 0.7 0.67 0.59 0.58 0.68 0.7 0.68 0.59 0.61 0.68 0.7 0.66 0.57 0.59 0.68 0.7 0.66 0.59 0.59 0.67 0.7 0.67 0.6 0.23 0.15 0.11 0.09 0.07 0.12 0.14 0.14 0.13 0.11 0.12 0.13 0.13 0.13 0.13 0.11 0.14 0.14 0.14 0.12 0.12 0.14 0.14 0.13 0.12 0.13 0.14 0.13 0.13 0.12
PRE1_3 0.49 0.68 1 0.68 0.49 0.62 0.7 0.72 0.69 0.61 0.61 0.69 0.72 0.71 0.61 0.62 0.71 0.73 0.69 0.59 0.61 0.7 0.74 0.69 0.61 0.6 0.69 0.73 0.7 0.62 0.17 0.11 0.09 0.07 0.05 0.08 0.11 0.11 0.1 0.09 0.08 0.1 0.1 0.11 0.1 0.09 0.11 0.11 0.1 0.09 0.09 0.09 0.11 0.11 0.09 0.09 0.11 0.1 0.11 0.09
PRE1_4 0.37 0.5 0.68 1 0.67 0.6 0.69 0.69 0.66 0.58 0.59 0.67 0.7 0.68 0.58 0.6 0.67 0.7 0.67 0.58 0.59 0.67 0.7 0.67 0.59 0.57 0.68 0.71 0.67 0.6 0.13 0.08 0.06 0.06 0.04 0.06 0.08 0.09 0.08 0.05 0.07 0.08 0.08 0.08 0.06 0.07 0.07 0.08 0.08 0.07 0.07 0.06 0.08 0.08 0.06 0.06 0.08 0.08 0.08 0.06
PRE1_5 0.29 0.38 0.49 0.67 1 0.54 0.6 0.61 0.58 0.52 0.51 0.6 0.62 0.59 0.51 0.53 0.58 0.61 0.6 0.52 0.54 0.59 0.61 0.59 0.51 0.52 0.59 0.62 0.58 0.54 0.1 0.06 0.07 0.05 0.03 0.06 0.08 0.07 0.05 0.05 0.05 0.07 0.07 0.07 0.05 0.07 0.06 0.06 0.06 0.06 0.06 0.05 0.07 0.07 0.06 0.04 0.07 0.07 0.07 0.06
PRE1_6 0.51 0.59 0.62 0.6 0.54 1 0.68 0.5 0.38 0.31 0.51 0.61 0.63 0.59 0.52 0.55 0.58 0.61 0.6 0.52 0.52 0.6 0.63 0.59 0.53 0.52 0.6 0.63 0.58 0.54 0.18 0.12 0.08 0.06 0.04 0.08 0.11 0.11 0.1 0.08 0.09 0.1 0.1 0.1 0.09 0.09 0.1 0.1 0.1 0.09 0.09 0.1 0.11 0.1 0.09 0.08 0.1 0.11 0.11 0.08
PRE1_7 0.58 0.67 0.7 0.69 0.6 0.68 1 0.67 0.5 0.38 0.57 0.69 0.71 0.67 0.59 0.61 0.67 0.69 0.67 0.58 0.59 0.68 0.7 0.68 0.58 0.57 0.67 0.72 0.69 0.59 0.2 0.12 0.09 0.07 0.04 0.09 0.12 0.12 0.1 0.09 0.09 0.11 0.11 0.11 0.11 0.09 0.11 0.11 0.11 0.1 0.1 0.1 0.11 0.11 0.1 0.09 0.12 0.11 0.11 0.09
PRE1_8 0.6 0.7 0.72 0.69 0.61 0.5 0.67 1 0.67 0.5 0.6 0.68 0.74 0.71 0.6 0.63 0.69 0.71 0.69 0.61 0.62 0.7 0.72 0.68 0.61 0.61 0.69 0.74 0.69 0.6 0.2 0.12 0.09 0.07 0.05 0.09 0.12 0.12 0.11 0.09 0.1 0.11 0.11 0.11 0.11 0.09 0.11 0.12 0.11 0.1 0.1 0.1 0.12 0.11 0.1 0.1 0.12 0.11 0.11 0.1
PRE1_9 0.59 0.67 0.69 0.66 0.58 0.38 0.5 0.67 1 0.65 0.6 0.66 0.69 0.68 0.58 0.59 0.67 0.71 0.66 0.56 0.57 0.69 0.69 0.66 0.59 0.58 0.66 0.67 0.68 0.61 0.2 0.14 0.12 0.11 0.08 0.12 0.14 0.14 0.13 0.11 0.12 0.13 0.13 0.14 0.12 0.12 0.13 0.14 0.13 0.12 0.12 0.12 0.14 0.14 0.11 0.11 0.14 0.13 0.14 0.12
PRE1_10 0.53 0.59 0.61 0.58 0.52 0.31 0.38 0.5 0.65 1 0.53 0.6 0.6 0.6 0.51 0.53 0.6 0.61 0.59 0.51 0.56 0.59 0.61 0.58 0.51 0.52 0.61 0.61 0.58 0.53 0.18 0.13 0.1 0.1 0.06 0.1 0.13 0.13 0.12 0.1 0.11 0.12 0.12 0.12 0.1 0.1 0.11 0.12 0.13 0.11 0.11 0.12 0.12 0.12 0.11 0.11 0.12 0.12 0.12 0.1
PRE1_11 0.51 0.58 0.61 0.59 0.51 0.51 0.57 0.6 0.6 0.53 1 0.65 0.48 0.39 0.29 0.52 0.59 0.6 0.58 0.52 0.51 0.58 0.6 0.58 0.54 0.51 0.56 0.59 0.58 0.55 0.18 0.11 0.09 0.07 0.04 0.09 0.1 0.1 0.1 0.09 0.09 0.1 0.1 0.1 0.09 0.09 0.1 0.11 0.1 0.08 0.09 0.1 0.1 0.1 0.09 0.08 0.11 0.1 0.1 0.09
PRE1_12 0.59 0.68 0.69 0.67 0.6 0.61 0.69 0.68 0.66 0.6 0.65 1 0.7 0.51 0.37 0.61 0.66 0.7 0.68 0.59 0.59 0.68 0.7 0.67 0.59 0.58 0.68 0.7 0.68 0.6 0.21 0.13 0.1 0.09 0.06 0.11 0.14 0.13 0.12 0.1 0.11 0.13 0.12 0.12 0.11 0.11 0.12 0.14 0.12 0.11 0.11 0.12 0.13 0.13 0.12 0.11 0.13 0.13 0.12 0.11
PRE1_13 0.61 0.7 0.72 0.7 0.62 0.63 0.71 0.74 0.69 0.6 0.48 0.7 1 0.69 0.48 0.62 0.7 0.74 0.71 0.59 0.64 0.72 0.73 0.69 0.58 0.6 0.69 0.75 0.7 0.62 0.21 0.14 0.1 0.09 0.07 0.11 0.14 0.14 0.12 0.1 0.12 0.13 0.13 0.12 0.11 0.11 0.12 0.13 0.13 0.12 0.11 0.13 0.13 0.13 0.12 0.11 0.13 0.13 0.13 0.11
PRE1_14 0.59 0.68 0.71 0.68 0.59 0.59 0.67 0.71 0.68 0.6 0.39 0.51 0.69 1 0.66 0.61 0.67 0.71 0.69 0.58 0.6 0.69 0.71 0.66 0.59 0.59 0.69 0.71 0.68 0.58 0.2 0.13 0.1 0.08 0.05 0.09 0.13 0.13 0.11 0.09 0.1 0.11 0.12 0.12 0.11 0.1 0.12 0.12 0.12 0.11 0.11 0.11 0.13 0.12 0.1 0.11 0.12 0.11 0.13 0.1
PRE1_15 0.51 0.59 0.61 0.58 0.51 0.52 0.59 0.6 0.58 0.51 0.29 0.37 0.48 0.66 1 0.55 0.6 0.6 0.55 0.51 0.51 0.58 0.6 0.58 0.53 0.51 0.61 0.61 0.56 0.52 0.17 0.11 0.09 0.07 0.05 0.08 0.11 0.11 0.1 0.08 0.08 0.09 0.1 0.11 0.1 0.08 0.1 0.1 0.1 0.1 0.1 0.09 0.11 0.1 0.08 0.09 0.11 0.11 0.1 0.08
PRE1_16 0.54 0.61 0.62 0.6 0.53 0.55 0.61 0.63 0.59 0.53 0.52 0.61 0.62 0.61 0.55 1 0.7 0.51 0.39 0.3 0.56 0.61 0.61 0.59 0.53 0.56 0.6 0.61 0.59 0.53 0.18 0.11 0.08 0.07 0.04 0.09 0.12 0.11 0.1 0.08 0.09 0.1 0.1 0.1 0.1 0.09 0.1 0.1 0.11 0.09 0.1 0.09 0.1 0.1 0.1 0.09 0.11 0.1 0.11 0.08
PRE1_17 0.58 0.68 0.71 0.67 0.58 0.58 0.67 0.69 0.67 0.6 0.59 0.66 0.7 0.67 0.6 0.7 1 0.67 0.49 0.35 0.6 0.68 0.69 0.67 0.58 0.58 0.65 0.7 0.67 0.61 0.19 0.12 0.1 0.09 0.05 0.1 0.12 0.12 0.12 0.1 0.1 0.12 0.11 0.12 0.11 0.09 0.11 0.12 0.12 0.11 0.11 0.12 0.12 0.11 0.1 0.1 0.12 0.12 0.12 0.1
PRE1_18 0.6 0.7 0.73 0.7 0.61 0.61 0.69 0.71 0.71 0.61 0.6 0.7 0.74 0.71 0.6 0.51 0.67 1 0.68 0.47 0.6 0.71 0.74 0.7 0.6 0.58 0.69 0.73 0.71 0.63 0.21 0.15 0.12 0.09 0.07 0.11 0.14 0.14 0.13 0.12 0.13 0.13 0.13 0.13 0.12 0.12 0.13 0.14 0.13 0.12 0.11 0.13 0.14 0.14 0.11 0.11 0.14 0.13 0.14 0.12
PRE1_19 0.58 0.66 0.69 0.67 0.6 0.6 0.67 0.69 0.66 0.59 0.58 0.68 0.71 0.69 0.55 0.39 0.49 0.68 1 0.65 0.6 0.67 0.7 0.65 0.59 0.57 0.68 0.7 0.67 0.6 0.2 0.13 0.1 0.08 0.06 0.09 0.13 0.14 0.12 0.1 0.11 0.12 0.12 0.12 0.1 0.11 0.12 0.13 0.11 0.1 0.11 0.11 0.12 0.12 0.1 0.11 0.12 0.12 0.12 0.1
PRE1_20 0.51 0.57 0.59 0.58 0.52 0.52 0.58 0.61 0.56 0.51 0.52 0.59 0.59 0.58 0.51 0.3 0.35 0.47 0.65 1 0.49 0.58 0.59 0.58 0.53 0.48 0.59 0.62 0.57 0.51 0.17 0.11 0.09 0.07 0.05 0.09 0.12 0.11 0.1 0.08 0.09 0.1 0.11 0.1 0.09 0.09 0.1 0.11 0.1 0.1 0.08 0.1 0.11 0.11 0.09 0.09 0.11 0.11 0.1 0.09
PRE1_21 0.53 0.59 0.61 0.59 0.54 0.52 0.59 0.62 0.57 0.56 0.51 0.59 0.64 0.6 0.51 0.56 0.6 0.6 0.6 0.49 1 0.69 0.51 0.37 0.28 0.53 0.6 0.64 0.58 0.5 0.18 0.11 0.09 0.07 0.05 0.09 0.11 0.1 0.1 0.08 0.09 0.11 0.1 0.1 0.09 0.08 0.1 0.11 0.11 0.09 0.09 0.1 0.11 0.11 0.08 0.08 0.1 0.11 0.11 0.09
PRE1_22 0.59 0.68 0.7 0.67 0.59 0.6 0.68 0.7 0.69 0.59 0.58 0.68 0.72 0.69 0.58 0.61 0.68 0.71 0.67 0.58 0.69 1 0.68 0.49 0.38 0.6 0.68 0.71 0.67 0.59 0.21 0.14 0.1 0.08 0.05 0.1 0.13 0.12 0.12 0.1 0.1 0.12 0.12 0.12 0.11 0.1 0.12 0.12 0.12 0.11 0.1 0.11 0.12 0.13 0.1 0.09 0.12 0.12 0.13 0.1
PRE1_23 0.6 0.7 0.74 0.7 0.61 0.63 0.7 0.72 0.69 0.61 0.6 0.7 0.73 0.71 0.6 0.61 0.69 0.74 0.7 0.59 0.51 0.68 1 0.66 0.5 0.58 0.7 0.72 0.71 0.63 0.19 0.13 0.1 0.08 0.06 0.11 0.13 0.12 0.11 0.1 0.1 0.12 0.12 0.11 0.11 0.1 0.11 0.13 0.12 0.1 0.11 0.11 0.12 0.11 0.1 0.11 0.12 0.11 0.12 0.1
PRE1_24 0.58 0.66 0.69 0.67 0.59 0.59 0.68 0.68 0.66 0.58 0.58 0.67 0.69 0.66 0.58 0.59 0.67 0.7 0.65 0.58 0.37 0.49 0.66 1 0.67 0.56 0.66 0.68 0.67 0.62 0.2 0.14 0.1 0.08 0.06 0.1 0.13 0.14 0.12 0.1 0.11 0.12 0.12 0.13 0.11 0.11 0.12 0.13 0.12 0.1 0.11 0.12 0.13 0.12 0.11 0.11 0.13 0.12 0.12 0.1
PRE1_25 0.52 0.59 0.61 0.59 0.51 0.53 0.58 0.61 0.59 0.51 0.54 0.59 0.58 0.59 0.53 0.53 0.58 0.6 0.59 0.53 0.28 0.38 0.5 0.67 1 0.51 0.59 0.61 0.58 0.54 0.19 0.12 0.1 0.08 0.06 0.09 0.13 0.13 0.11 0.08 0.1 0.11 0.11 0.12 0.1 0.1 0.11 0.11 0.12 0.11 0.1 0.11 0.12 0.12 0.1 0.1 0.12 0.11 0.11 0.1
PRE1_26 0.5 0.59 0.6 0.57 0.52 0.52 0.57 0.61 0.58 0.52 0.51 0.58 0.6 0.59 0.51 0.56 0.58 0.58 0.57 0.48 0.53 0.6 0.58 0.56 0.51 1 0.65 0.5 0.35 0.28 0.18 0.11 0.08 0.06 0.03 0.08 0.1 0.1 0.1 0.08 0.08 0.09 0.09 0.1 0.09 0.08 0.1 0.09 0.09 0.09 0.09 0.09 0.1 0.1 0.08 0.09 0.1 0.09 0.09 0.08
PRE1_27 0.59 0.67 0.69 0.68 0.59 0.6 0.67 0.69 0.66 0.61 0.56 0.68 0.69 0.69 0.61 0.6 0.65 0.69 0.68 0.59 0.6 0.68 0.7 0.66 0.59 0.65 1 0.67 0.5 0.41 0.22 0.14 0.1 0.09 0.06 0.1 0.14 0.13 0.12 0.11 0.11 0.12 0.12 0.12 0.12 0.11 0.13 0.13 0.12 0.11 0.12 0.11 0.13 0.13 0.11 0.11 0.13 0.13 0.13 0.1
PRE1_28 0.61 0.7 0.73 0.71 0.62 0.63 0.72 0.74 0.67 0.61 0.59 0.7 0.75 0.71 0.61 0.61 0.7 0.73 0.7 0.62 0.64 0.71 0.72 0.68 0.61 0.5 0.67 1 0.67 0.52 0.21 0.14 0.11 0.09 0.06 0.11 0.14 0.13 0.12 0.1 0.12 0.13 0.12 0.12 0.11 0.11 0.12 0.13 0.13 0.11 0.11 0.12 0.13 0.13 0.11 0.11 0.13 0.13 0.13 0.1
PRE1_29 0.58 0.67 0.7 0.67 0.58 0.58 0.69 0.69 0.68 0.58 0.58 0.68 0.7 0.68 0.56 0.59 0.67 0.71 0.67 0.57 0.58 0.67 0.71 0.67 0.58 0.35 0.5 0.67 1 0.68 0.19 0.12 0.1 0.09 0.06 0.09 0.13 0.13 0.11 0.09 0.1 0.11 0.12 0.12 0.1 0.11 0.11 0.12 0.12 0.1 0.1 0.11 0.12 0.11 0.1 0.09 0.12 0.12 0.12 0.1
PRE1_30 0.53 0.6 0.62 0.6 0.54 0.54 0.59 0.6 0.61 0.53 0.55 0.6 0.62 0.58 0.52 0.53 0.61 0.63 0.6 0.51 0.5 0.59 0.63 0.62 0.54 0.28 0.41 0.52 0.68 1 0.18 0.12 0.1 0.08 0.07 0.1 0.12 0.13 0.11 0.09 0.1 0.11 0.12 0.11 0.1 0.09 0.11 0.12 0.12 0.1 0.1 0.11 0.13 0.11 0.09 0.09 0.12 0.12 0.12 0.1
POST1_1 0.34 0.23 0.17 0.13 0.1 0.18 0.2 0.2 0.2 0.18 0.18 0.21 0.21 0.2 0.17 0.18 0.19 0.21 0.2 0.17 0.18 0.21 0.19 0.2 0.19 0.18 0.22 0.21 0.19 0.18 1 0.66 0.48 0.36 0.28 0.49 0.58 0.59 0.58 0.52 0.51 0.56 0.59 0.58 0.53 0.49 0.59 0.61 0.58 0.5 0.51 0.59 0.59 0.57 0.51 0.51 0.59 0.6 0.57 0.51
POST1_2 0.22 0.15 0.11 0.08 0.06 0.12 0.12 0.12 0.14 0.13 0.11 0.13 0.14 0.13 0.11 0.11 0.12 0.15 0.13 0.11 0.11 0.14 0.13 0.14 0.12 0.11 0.14 0.14 0.12 0.12 0.66 1 0.67 0.49 0.37 0.57 0.67 0.69 0.68 0.58 0.57 0.66 0.69 0.67 0.6 0.59 0.69 0.69 0.66 0.57 0.59 0.67 0.71 0.66 0.55 0.57 0.67 0.7 0.67 0.59
POST1_3 0.16 0.11 0.09 0.06 0.07 0.08 0.09 0.09 0.12 0.1 0.09 0.1 0.1 0.1 0.09 0.08 0.1 0.12 0.1 0.09 0.09 0.1 0.1 0.1 0.1 0.08 0.1 0.11 0.1 0.1 0.48 0.67 1 0.68 0.48 0.58 0.7 0.72 0.7 0.61 0.6 0.7 0.72 0.7 0.6 0.6 0.71 0.73 0.69 0.59 0.61 0.7 0.74 0.69 0.58 0.6 0.7 0.73 0.69 0.61
POST1_4 0.12 0.09 0.07 0.06 0.05 0.06 0.07 0.07 0.11 0.1 0.07 0.09 0.09 0.08 0.07 0.07 0.09 0.09 0.08 0.07 0.07 0.08 0.08 0.08 0.08 0.06 0.09 0.09 0.09 0.08 0.36 0.49 0.68 1 0.66 0.56 0.68 0.69 0.67 0.58 0.57 0.68 0.7 0.67 0.57 0.59 0.68 0.7 0.66 0.56 0.6 0.66 0.71 0.66 0.56 0.58 0.67 0.69 0.66 0.59
POST1_5 0.09 0.07 0.05 0.04 0.03 0.04 0.04 0.05 0.08 0.06 0.04 0.06 0.07 0.05 0.05 0.04 0.05 0.07 0.06 0.05 0.05 0.05 0.06 0.06 0.06 0.03 0.06 0.06 0.06 0.07 0.28 0.37 0.48 0.66 1 0.51 0.58 0.6 0.58 0.51 0.51 0.58 0.6 0.58 0.51 0.52 0.59 0.59 0.58 0.51 0.53 0.58 0.6 0.57 0.5 0.5 0.57 0.59 0.59 0.54
POST1_6 0.16 0.12 0.08 0.06 0.06 0.08 0.09 0.09 0.12 0.1 0.09 0.11 0.11 0.09 0.08 0.09 0.1 0.11 0.09 0.09 0.09 0.1 0.11 0.1 0.09 0.08 0.1 0.11 0.09 0.1 0.49 0.57 0.58 0.56 0.51 1 0.66 0.46 0.36 0.25 0.49 0.55 0.59 0.57 0.51 0.49 0.58 0.59 0.56 0.5 0.51 0.57 0.58 0.57 0.48 0.49 0.56 0.58 0.56 0.53
POST1_7 0.2 0.14 0.11 0.08 0.08 0.11 0.12 0.12 0.14 0.13 0.1 0.14 0.14 0.13 0.11 0.12 0.12 0.14 0.13 0.12 0.11 0.13 0.13 0.13 0.13 0.1 0.14 0.14 0.13 0.12 0.58 0.67 0.7 0.68 0.58 0.66 1 0.68 0.5 0.38 0.58 0.67 0.7 0.68 0.57 0.56 0.69 0.71 0.68 0.58 0.6 0.69 0.71 0.66 0.56 0.58 0.67 0.71 0.68 0.59
POST1_8 0.2 0.14 0.11 0.09 0.07 0.11 0.12 0.12 0.14 0.13 0.1 0.13 0.14 0.13 0.11 0.11 0.12 0.14 0.14 0.11 0.1 0.12 0.12 0.14 0.13 0.1 0.13 0.13 0.13 0.13 0.59 0.69 0.72 0.69 0.6 0.46 0.68 1 0.67 0.49 0.6 0.69 0.71 0.7 0.6 0.6 0.71 0.72 0.68 0.58 0.61 0.7 0.74 0.68 0.57 0.59 0.68 0.73 0.7 0.6
POST1_9 0.2 0.13 0.1 0.08 0.05 0.1 0.1 0.11 0.13 0.12 0.1 0.12 0.12 0.11 0.1 0.1 0.12 0.13 0.12 0.1 0.1 0.12 0.11 0.12 0.11 0.1 0.12 0.12 0.11 0.11 0.58 0.68 0.7 0.67 0.58 0.36 0.5 0.67 1 0.67 0.57 0.67 0.7 0.67 0.6 0.61 0.68 0.7 0.66 0.56 0.6 0.67 0.71 0.68 0.56 0.58 0.67 0.7 0.66 0.6
POST1_10 0.17 0.11 0.09 0.05 0.05 0.08 0.09 0.09 0.11 0.1 0.09 0.1 0.1 0.09 0.08 0.08 0.1 0.12 0.1 0.08 0.08 0.1 0.1 0.1 0.08 0.08 0.11 0.1 0.09 0.09 0.52 0.58 0.61 0.58 0.51 0.25 0.38 0.49 0.67 1 0.51 0.59 0.6 0.57 0.53 0.53 0.59 0.59 0.58 0.52 0.52 0.58 0.61 0.57 0.53 0.53 0.6 0.59 0.58 0.51
POST1_11 0.18 0.12 0.08 0.07 0.05 0.09 0.09 0.1 0.12 0.11 0.09 0.11 0.12 0.1 0.08 0.09 0.1 0.13 0.11 0.09 0.09 0.1 0.1 0.11 0.1 0.08 0.11 0.12 0.1 0.1 0.51 0.57 0.6 0.57 0.51 0.49 0.58 0.6 0.57 0.51 1 0.65 0.46 0.37 0.28 0.49 0.58 0.62 0.57 0.5 0.52 0.59 0.61 0.56 0.49 0.51 0.57 0.6 0.57 0.52
POST1_12 0.19 0.13 0.1 0.08 0.07 0.1 0.11 0.11 0.13 0.12 0.1 0.13 0.13 0.11 0.09 0.1 0.12 0.13 0.12 0.1 0.11 0.12 0.12 0.12 0.11 0.09 0.12 0.13 0.11 0.11 0.56 0.66 0.7 0.68 0.58 0.55 0.67 0.69 0.67 0.59 0.65 1 0.66 0.49 0.38 0.57 0.68 0.69 0.68 0.56 0.6 0.67 0.7 0.65 0.57 0.56 0.66 0.69 0.67 0.6
POST1_13 0.19 0.13 0.1 0.08 0.07 0.1 0.11 0.11 0.13 0.12 0.1 0.12 0.13 0.12 0.1 0.1 0.11 0.13 0.12 0.11 0.1 0.12 0.12 0.12 0.11 0.09 0.12 0.12 0.12 0.12 0.59 0.69 0.72 0.7 0.6 0.59 0.7 0.71 0.7 0.6 0.46 0.66 1 0.68 0.5 0.61 0.69 0.71 0.68 0.59 0.61 0.69 0.72 0.69 0.59 0.59 0.69 0.73 0.68 0.6
POST1_14 0.19 0.13 0.11 0.08 0.07 0.1 0.11 0.11 0.14 0.12 0.1 0.12 0.12 0.12 0.11 0.1 0.12 0.13 0.12 0.1 0.1 0.12 0.11 0.13 0.12 0.1 0.12 0.12 0.12 0.11 0.58 0.67 0.7 0.67 0.58 0.57 0.68 0.7 0.67 0.57 0.37 0.49 0.68 1 0.67 0.59 0.7 0.69 0.65 0.57 0.59 0.67 0.71 0.67 0.56 0.59 0.67 0.68 0.67 0.59
POST1_15 0.18 0.13 0.1 0.06 0.05 0.09 0.11 0.11 0.12 0.1 0.09 0.11 0.11 0.11 0.1 0.1 0.11 0.12 0.1 0.09 0.09 0.11 0.11 0.11 0.1 0.09 0.12 0.11 0.1 0.1 0.53 0.6 0.6 0.57 0.51 0.51 0.57 0.6 0.6 0.53 0.28 0.38 0.5 0.67 1 0.52 0.61 0.6 0.57 0.52 0.53 0.6 0.61 0.58 0.49 0.51 0.6 0.61 0.58 0.52
POST1_16 0.15 0.11 0.09 0.07 0.07 0.09 0.09 0.09 0.12 0.1 0.09 0.11 0.11 0.1 0.08 0.09 0.09 0.12 0.11 0.09 0.08 0.1 0.1 0.11 0.1 0.08 0.11 0.11 0.11 0.09 0.49 0.59 0.6 0.59 0.52 0.49 0.56 0.6 0.61 0.53 0.49 0.57 0.61 0.59 0.52 1 0.68 0.49 0.34 0.27 0.53 0.58 0.6 0.58 0.49 0.5 0.59 0.6 0.58 0.52
POST1_17 0.19 0.14 0.11 0.07 0.06 0.1 0.11 0.11 0.13 0.11 0.1 0.12 0.12 0.12 0.1 0.1 0.11 0.13 0.12 0.1 0.1 0.12 0.11 0.12 0.11 0.1 0.13 0.12 0.11 0.11 0.59 0.69 0.71 0.68 0.59 0.58 0.69 0.71 0.68 0.59 0.58 0.68 0.69 0.7 0.61 0.68 1 0.69 0.51 0.37 0.61 0.68 0.72 0.68 0.56 0.59 0.68 0.72 0.68 0.59
POST1_18 0.21 0.14 0.11 0.08 0.06 0.1 0.11 0.12 0.14 0.12 0.11 0.14 0.13 0.12 0.1 0.1 0.12 0.14 0.13 0.11 0.11 0.12 0.13 0.13 0.11 0.09 0.13 0.13 0.12 0.12 0.61 0.69 0.73 0.7 0.59 0.59 0.71 0.72 0.7 0.59 0.62 0.69 0.71 0.69 0.6 0.49 0.69 1 0.68 0.47 0.6 0.71 0.73 0.69 0.58 0.6 0.68 0.73 0.7 0.61
POST1_19 0.2 0.14 0.1 0.08 0.06 0.1 0.11 0.11 0.13 0.13 0.1 0.12 0.13 0.12 0.1 0.11 0.12 0.13 0.11 0.1 0.11 0.12 0.12 0.12 0.12 0.09 0.12 0.13 0.12 0.12 0.58 0.66 0.69 0.66 0.58 0.56 0.68 0.68 0.66 0.58 0.57 0.68 0.68 0.65 0.57 0.34 0.51 0.68 1 0.63 0.58 0.67 0.7 0.64 0.57 0.58 0.67 0.68 0.65 0.58
POST1_20 0.18 0.12 0.09 0.07 0.06 0.09 0.1 0.1 0.12 0.11 0.08 0.11 0.12 0.11 0.1 0.09 0.11 0.12 0.1 0.1 0.09 0.11 0.1 0.1 0.11 0.09 0.11 0.11 0.1 0.1 0.5 0.57 0.59 0.56 0.51 0.5 0.58 0.58 0.56 0.52 0.5 0.56 0.59 0.57 0.52 0.27 0.37 0.47 0.63 1 0.51 0.57 0.6 0.56 0.5 0.5 0.56 0.58 0.56 0.54
POST1_21 0.17 0.12 0.09 0.07 0.06 0.09 0.1 0.1 0.12 0.11 0.09 0.11 0.11 0.11 0.1 0.1 0.11 0.11 0.11 0.08 0.09 0.1 0.11 0.11 0.1 0.09 0.12 0.11 0.1 0.1 0.51 0.59 0.61 0.6 0.53 0.51 0.6 0.61 0.6 0.52 0.52 0.6 0.61 0.59 0.53 0.53 0.61 0.6 0.58 0.51 1 0.68 0.51 0.36 0.26 0.52 0.58 0.6 0.58 0.55
POST1_22 0.2 0.14 0.09 0.06 0.05 0.1 0.1 0.1 0.12 0.12 0.1 0.12 0.13 0.11 0.09 0.09 0.12 0.13 0.11 0.1 0.1 0.11 0.11 0.12 0.11 0.09 0.11 0.12 0.11 0.11 0.59 0.67 0.7 0.66 0.58 0.57 0.69 0.7 0.67 0.58 0.59 0.67 0.69 0.67 0.6 0.58 0.68 0.71 0.67 0.57 0.68 1 0.68 0.48 0.36 0.58 0.68 0.7 0.67 0.6
POST1_23 0.2 0.14 0.11 0.08 0.07 0.11 0.11 0.12 0.14 0.12 0.1 0.13 0.13 0.13 0.11 0.1 0.12 0.14 0.12 0.11 0.11 0.12 0.12 0.13 0.12 0.1 0.13 0.13 0.12 0.13 0.59 0.71 0.74 0.71 0.6 0.58 0.71 0.74 0.71 0.61 0.61 0.7 0.72 0.71 0.61 0.6 0.72 0.73 0.7 0.6 0.51 0.68 1 0.68 0.46 0.6 0.71 0.75 0.7 0.6
POST1_24 0.19 0.13 0.11 0.08 0.07 0.1 0.11 0.11 0.14 0.12 0.1 0.13 0.13 0.12 0.1 0.1 0.11 0.14 0.12 0.11 0.11 0.13 0.11 0.12 0.12 0.1 0.13 0.13 0.11 0.11 0.57 0.66 0.69 0.66 0.57 0.57 0.66 0.68 0.68 0.57 0.56 0.65 0.69 0.67 0.58 0.58 0.68 0.69 0.64 0.56 0.36 0.48 0.68 1 0.64 0.57 0.66 0.69 0.66 0.57
POST1_25 0.17 0.12 0.09 0.06 0.06 0.09 0.1 0.1 0.11 0.11 0.09 0.12 0.12 0.1 0.08 0.1 0.1 0.11 0.1 0.09 0.08 0.1 0.1 0.11 0.1 0.08 0.11 0.11 0.1 0.09 0.51 0.55 0.58 0.56 0.5 0.48 0.56 0.57 0.56 0.53 0.49 0.57 0.59 0.56 0.49 0.49 0.56 0.58 0.57 0.5 0.26 0.36 0.46 0.64 1 0.49 0.55 0.57 0.56 0.53
POST1_26 0.18 0.13 0.09 0.06 0.04 0.08 0.09 0.1 0.11 0.11 0.08 0.11 0.11 0.11 0.09 0.09 0.1 0.11 0.11 0.09 0.08 0.09 0.11 0.11 0.1 0.09 0.11 0.11 0.09 0.09 0.51 0.57 0.6 0.58 0.5 0.49 0.58 0.59 0.58 0.53 0.51 0.56 0.59 0.59 0.51 0.5 0.59 0.6 0.58 0.5 0.52 0.58 0.6 0.57 0.49 1 0.66 0.48 0.35 0.28
POST1_27 0.2 0.14 0.11 0.08 0.07 0.1 0.12 0.12 0.14 0.12 0.11 0.13 0.13 0.12 0.11 0.11 0.12 0.14 0.12 0.11 0.1 0.12 0.12 0.13 0.12 0.1 0.13 0.13 0.12 0.12 0.59 0.67 0.7 0.67 0.57 0.56 0.67 0.68 0.67 0.6 0.57 0.66 0.69 0.67 0.6 0.59 0.68 0.68 0.67 0.56 0.58 0.68 0.71 0.66 0.55 0.66 1 0.68 0.47 0.39
POST1_28 0.2 0.13 0.1 0.08 0.07 0.11 0.11 0.11 0.13 0.12 0.1 0.13 0.13 0.11 0.11 0.1 0.12 0.13 0.12 0.11 0.11 0.12 0.11 0.12 0.11 0.09 0.13 0.13 0.12 0.12 0.6 0.7 0.73 0.69 0.59 0.58 0.71 0.73 0.7 0.59 0.6 0.69 0.73 0.68 0.61 0.6 0.72 0.73 0.68 0.58 0.6 0.7 0.75 0.69 0.57 0.48 0.68 1 0.67 0.49
POST1_29 0.19 0.13 0.11 0.08 0.07 0.11 0.11 0.11 0.14 0.12 0.1 0.12 0.13 0.13 0.1 0.11 0.12 0.14 0.12 0.1 0.11 0.13 0.12 0.12 0.11 0.09 0.13 0.13 0.12 0.12 0.57 0.67 0.69 0.66 0.59 0.56 0.68 0.7 0.66 0.58 0.57 0.67 0.68 0.67 0.58 0.58 0.68 0.7 0.65 0.56 0.58 0.67 0.7 0.66 0.56 0.35 0.47 0.67 1 0.67
POST1_30 0.16 0.12 0.09 0.06 0.06 0.08 0.09 0.1 0.12 0.1 0.09 0.11 0.11 0.1 0.08 0.08 0.1 0.12 0.1 0.09 0.09 0.1 0.1 0.1 0.1 0.08 0.1 0.1 0.1 0.1 0.51 0.59 0.61 0.59 0.54 0.53 0.59 0.6 0.6 0.51 0.52 0.6 0.6 0.59 0.52 0.52 0.59 0.61 0.58 0.54 0.55 0.6 0.6 0.57 0.53 0.28 0.39 0.49 0.67 1
# mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP:
PRE_alpha = CronbachAlpha(PP_30.30[pre_30mzp])
POST_alpha = CronbachAlpha(PP_30.30[post_30mzp])
PP_30.30_Alpha = FisherZInv(mean(c(FisherZ(PRE_alpha), FisherZ(POST_alpha))))

Korrelation zwischen den Pre- und Post-Intervall-Mittelwerten = 0.179.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Pre-MZP (Fisher-Z-transformiert): r = 0.65.
Durchschnittliche paarweise Korrelation zwischen aufeinanderfolgenden Post-MZP (Fisher-Z-transformiert): r = 0.64.
Mittleres Cronbach´s Alpha zwischen Pre-MZP und Post-MZP = 0.978.


1.3.3 PP_1.1 (je 1 MZP)

PP_1.1_rtt = cor(PP_1.1$PRE, PP_1.1$POST)
PP_1.1_Alpha = CronbachAlpha(PP_1.1[c("PRE","POST")])

Korrelation zwischen den Pre- und Post-MZP (Retest-Reliabilität) = 0.336.
Cronbach´s Alpha zwischen dem Pre- und dem Post-MZP = 0.494.


1.4 Pre-Post-Differenz

Verteilungen der Pre-Post-(Mittelwerts-)Veränderungen

#hist(PP_5.5$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_5.5 = ",
#  round(mean(PP_5.5$MeanDiff), digits = 3)))

#hist(PP_30.30$MeanDiff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Intervall-Differenz in PP_30.30 = ",
#  round(mean(PP_30.30$MeanDiff), digits = 3)))

#hist(PP_1.1$Diff, col = "lightblue1", main = paste0("Mittlere Pre-Post-Differenz in PP_1.1 = ", 
#  round(mean(PP_1.1$Diff), digits = 3)))

temp = tibble(MeanDiffs = c(PP_5.5$MeanDiff, PP_30.30$MeanDiff, PP_1.1$Diff),
              Datasets = rep(c("PP_5.5", "PP_30.30", "PP_1.1"), each = length(PP_5.5$MeanDiff)))

temp %>%
  ggplot(aes(x = MeanDiffs, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "Pre-Post-Differences", x = "PHQ-9 Pre-Post-Difference")

scatter.hist(PP_1.1$Diff, PP_30.30$MeanDiff, xlab = "PP_1.1$Diff",
  ylab = "PP_30.30$MeanDiff", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation zwischen den Pre-Post-Differenzen in PP_1.1 und PP_30.30 = 0.638.

Prozentuale Überlappung der Pre-Post-(Mittelwerts-)Veränderungen

# Overlap-Plots zum Vergleich
final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff), 
           overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_30.30_MeanDiff = PP_30.30$MeanDiff))$OV)

final.plot(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff), 
           overlap(list(PP_5.5_MeanDiff = PP_5.5$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)

final.plot(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff), 
           overlap(list(PP_30.30_MeanDiff = PP_30.30$MeanDiff, PP_1.1_Diff = PP_1.1$Diff))$OV)


1.4.1 Cohen´s d

Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den Original-Simulationsdaten (je 5 MZP)

\[ d = \frac{\overline{x_{1}} - \overline{x_{2}}} {\sqrt{0.5 \cdot (s_{x}^2 + s_{y}^2)}} \]

\(\overline{x_{1}}\) = mean of subject´s pretest scores, \(\overline{x_{2}}\) = mean of subject´s posttest scores, \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of posttest time points

PP_5.5$Cohen_d = (PP_5.5$PRE_Mean - PP_5.5$POST_Mean) / sqrt(0.5 * (PP_5.5$ind.pretestSD^2 + PP_5.5$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

hist(PP_5.5$Cohen_d, col = "lightblue1", main = "PP_5.5$Cohen_d")

cohen_d_5.5 = (mean(PP_5.5$PRE_Mean) - mean(PP_5.5$POST_Mean)) / sqrt(0.5 * (mean(PP_5.5$ind.pretestSD)^2 +
  mean(PP_5.5$ind.posttestSD)^2))

final.plot(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean), 
           overlap(list(PP_5.5_PRE_Mean = PP_5.5$PRE_Mean, PP_5.5_POST_Mean = PP_5.5$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_5.5 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_5.5 = 1.697.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_5.5 = 1.416.


Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-Intervall in den erweiterten Intervall-Daten (je 30 MZP)

PP_30.30$Cohen_d = (PP_30.30$PRE_Mean - PP_30.30$POST_Mean) / sqrt(0.5 * (PP_30.30$ind.pretestSD^2 +
  PP_30.30$ind.posttestSD^2))

# Sollen Cohen_d %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {Cohen_d[Cohen_d %in% c(-Inf,Inf)] = NA})

hist(PP_30.30$Cohen_d, col = "lightblue1", main = "PP_30.30$Cohen_d")

cohen_d_30.30 = (mean(PP_30.30$PRE_Mean) - mean(PP_30.30$POST_Mean)) / sqrt(0.5 * (mean(PP_30.30$ind.pretestSD)^2 + mean(PP_30.30$ind.posttestSD)^2))

final.plot(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean = PP_30.30$POST_Mean), 
           overlap(list(PP_30.30_PRE_Mean = PP_30.30$PRE_Mean, PP_30.30_POST_Mean =
                          PP_30.30$POST_Mean))$OV)

Gepoolte Varianz zwischen Pre- und Post-Intervall-Mittelwerten in PP_30.30 = 4.031.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten (für jede Person einzeln berechnet) in PP_30.30 = 1.866.
Durchschnittliches Cohen´s d zwischen Pre- und Post-Mittelwerten in PP_30.30 = 1.556.


Cohen´s d (mit gepoolten SDs) vom Pre- zum Post-MZP in der Stichprobe mit je 1 MZP

\[ d = \frac{\overline{X_{1}} - \overline{X_{2}}} {\sqrt{0.5 \cdot (s_{X}^2 + s_{Y}^2)}} \]

\(\overline{X_{1}}\) = mean of pretest scores in the whole sample, \(\overline{X_{2}}\) = mean of posttest scores in the whole sample, \(s_{X}\) = standard deviation of pretest scores in the whole sample, \(s_{Y}\) = standard deviation of posttest scores in the whole sample

cohen_d_1.1 = (mean(PP_1.1$PRE) - mean(PP_1.1$POST)) / sqrt(0.5 * (sd(PP_1.1$PRE)^2 + sd(PP_1.1$POST)^2))

final.plot(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST), 
           overlap(list(PP_1.1_PRE = PP_1.1$PRE, PP_1.1_POST = PP_1.1$POST))$OV)

Gepoolte Varianz zwischen dem Pre- und Post-MZP in PP_1.1 = 5.074.
Durchschnittliches Cohen´s d zwischen dem Pre- und Post-MZP in PP_1.1 = 0.916.


1.5 Klinische PHQ-9-Interpretation

PHQ_Int = tibble(PHQ_Score = c("0-4","5-9","10-14","15-19","20-27"),
       Klassifikation = c(0,1,2,3,4),
       Interpretation = c("Minimal or none","Mild","Moderate","Moderately severe","Severe"))

1.5.1 PP_5.5

PP_5.5 = PP_5.5 %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 3 0.04
5-9 1 Mild 3598 43.74
10-14 2 Moderate 4384 53.29
15-19 3 Moderately severe 241 2.93
20-27 4 Severe NA NA
PP_5.5 = PP_5.5 %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 1691 20.56
5-9 1 Mild 4795 58.29
10-14 2 Moderate 1718 20.88
15-19 3 Moderately severe 22 0.27
20-27 4 Severe NA NA
temp = tibble(Klassifikation = c(PP_5.5$PRE_Mean_klass, PP_5.5$POST_Mean_klass),
              MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_5.5$PRE_Mean_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_5.5: PHQ-9 Classification", x = "Classification")


1.5.2 PP_30.30

PP_30.30 = PP_30.30 %>% 
  mutate(PRE_Mean_klass = case_when(
    PRE_Mean <= 4 ~ 0,
    PRE_Mean > 4 & PRE_Mean < 10 ~ 1,
    PRE_Mean >= 10 & PRE_Mean < 15 ~ 2,
    PRE_Mean >= 15 & PRE_Mean < 20 ~ 3,
    PRE_Mean >= 20 ~ 4,
    TRUE ~ PRE_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(PRE_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 3 0.04
5-9 1 Mild 3598 43.74
10-14 2 Moderate 4384 53.29
15-19 3 Moderately severe 241 2.93
20-27 4 Severe NA NA
PP_30.30 = PP_30.30 %>% 
  mutate(POST_Mean_klass = case_when(
    POST_Mean <= 4 ~ 0,
    POST_Mean > 4 & POST_Mean < 10 ~ 1,
    POST_Mean >= 10 & POST_Mean < 15 ~ 2,
    POST_Mean >= 15 & POST_Mean < 20 ~ 3,
    POST_Mean >= 20 ~ 4,
    TRUE ~ POST_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(POST_Mean_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_Mean_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_Mean_klass Interpretation n Percentage
0-4 0 Minimal or none 1691 20.56
5-9 1 Mild 4795 58.29
10-14 2 Moderate 1718 20.88
15-19 3 Moderately severe 22 0.27
20-27 4 Severe NA NA
temp = tibble(Klassifikation = c(PP_30.30$PRE_Mean_klass, PP_30.30$POST_Mean_klass),
              MZP = rep(c("PRE_Mean_klass", "POST_Mean_klass"), each = length(PP_30.30$PRE_Mean_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_30.30: PHQ-9 Classification", x = "Classification")


1.5.3 PP_1.1

PP_1.1 = PP_1.1 %>% 
  mutate(PRE_klass = case_when(
    PRE <= 4 ~ 0,
    PRE > 4 & PRE < 10 ~ 1,
    PRE >= 10 & PRE < 15 ~ 2,
    PRE >= 15 & PRE < 20 ~ 3,
    PRE >= 20 ~ 4,
    TRUE ~ as.numeric(PRE)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(PRE_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(PRE_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score PRE_klass Interpretation n Percentage
0-4 0 Minimal or none 258 3.14
5-9 1 Mild 2992 36.37
10-14 2 Moderate 4303 52.31
15-19 3 Moderately severe 639 7.77
20-27 4 Severe 34 0.41
PP_1.1 = PP_1.1 %>% 
  mutate(POST_klass = case_when(
    POST <= 4 ~ 0,
    POST > 4 & POST < 10 ~ 1,
    POST >= 10 & POST < 15 ~ 2,
    POST >= 15 & POST < 20 ~ 3,
    POST >= 20 ~ 4,
    TRUE ~ as.numeric(POST)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(POST_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PHQ_Int %>%
  dplyr::rename(POST_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PHQ_Score POST_klass Interpretation n Percentage
0-4 0 Minimal or none 2495 30.33
5-9 1 Mild 3606 43.84
10-14 2 Moderate 1733 21.07
15-19 3 Moderately severe 382 4.64
20-27 4 Severe 10 0.12
temp = tibble(Klassifikation = c(PP_1.1$PRE_klass, PP_1.1$POST_klass),
              MZP = rep(c("PRE_klass", "POST_klass"), each = length(PP_1.1$PRE_klass)))

temp %>%
  ggplot(aes(x = Klassifikation, fill = MZP)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(title = "PP_1.1: PHQ-9 Classification", x = "Classification")


1.6 Percentage Change (PC)


\[ PC = \Bigl(1 - \frac{\overline{x_{2}}} {\overline{x_{1}}}\Bigr) \cdot 100 \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores

Interpretation des Percentage Change:

PC_Int = tibble(PC = c("PC <= -50","-50 < PC <= -25","-25 < PC < 25","25 <= PC < 50","PC >= 50"),
                Klassifikation = c(-2,-1,0,1,2),
                Interpretation = c("starke Verschlechterung","Verschlechterung","keine Veränderung",
                                   "Verbesserung","starke Verbesserung"))

1.6.1 PP_5.5

PP_5.5$Mean_PC = (1-(PP_5.5$POST_Mean / PP_5.5$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

PP_5.5 = PP_5.5 %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = PP_5.5 %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC Mean_PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 225 2.74
-50 < PC <= -25 -1 Verschlechterung 391 4.75
-25 < PC < 25 0 keine Veränderung 2774 33.72
25 <= PC < 50 1 Verbesserung 2276 27.67
PC >= 50 2 starke Verbesserung 2560 31.12
x = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.


1.6.2 PP_30.30

PP_30.30$Mean_PC = (1-(PP_30.30$POST_Mean / PP_30.30$PRE_Mean)) * 100

# Sollen Mean_PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

PP_30.30 = PP_30.30 %>% 
  mutate(Mean_PC_klass = case_when(
    Mean_PC <= -50 ~ -2,
    Mean_PC > -50 & Mean_PC <= -25 ~ -1,
    Mean_PC > -25 & Mean_PC < 25 ~ 0,
    Mean_PC >= 25 & Mean_PC < 50 ~ 1,
    Mean_PC >= 50 ~ 2,
    TRUE ~ Mean_PC
  )
)


temp = PP_30.30 %>% 
  dplyr::count(Mean_PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(Mean_PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC Mean_PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 225 2.74
-50 < PC <= -25 -1 Verschlechterung 391 4.75
-25 < PC < 25 0 keine Veränderung 2774 33.72
25 <= PC < 50 1 Verbesserung 2276 27.67
PC >= 50 2 starke Verbesserung 2560 31.12
x = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$Mean_PC, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation Mean Percentage Change (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = 0.375.


1.6.3 PP_1.1

PP_1.1$PC = (1 - (PP_1.1$POST / PP_1.1$PRE)) * 100

# Sollen PC %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>% 
#  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

PP_1.1 = PP_1.1 %>% 
  mutate(PC_klass = case_when(
    PC <= -50 ~ -2,
    PC > -50 & PC <= -25 ~ -1,
    PC > -25 & PC < 25 ~ 0,
    PC >= 25 & PC < 50 ~ 1,
    PC >= 50 ~ 2,
    TRUE ~ as.numeric(PC)
  )
)


temp = PP_1.1 %>% 
  dplyr::count(PC_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

PC_Int %>%
  dplyr::rename(PC_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
PC PC_klass Interpretation n Percentage
PC <= -50 -2 starke Verschlechterung 175 2.13
-50 < PC <= -25 -1 Verschlechterung 624 7.59
-25 < PC < 25 0 keine Veränderung 2684 32.63
25 <= PC < 50 1 Verbesserung 1810 22.00
PC >= 50 2 starke Verbesserung 2933 35.66
x = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

y = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE, y$PC, xlab = "PP_1.1$PRE", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation von Percentage Change (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = 0.243.


1.6.4 Zusammenhang im Scatter-Histogramm

x = PP_5.5 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {Mean_PC[Mean_PC %in% c(-Inf,Inf)] = NA})

z = PP_1.1 %>% 
  within(., {PC[PC %in% c(-Inf,Inf)] = NA})

scatter.hist(x$Mean_PC, y$Mean_PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_30.30$Mean_PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(y$Mean_PC, z$PC, xlab = "PP_30.30$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(x$Mean_PC, z$PC, xlab = "PP_5.5$Mean_PC", ylab = "PP_1.1$PC", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))


1.7 Reliable Change Index (JT)


\[ RCI = \frac{x_{2} - x_{1}} {s_{diff}} \]

\[ s_{diff} = \sqrt{2 \cdot (S_{E})^2} \]

\[ SE = s_{1} \cdot \sqrt{1 - r_{xx´}} \]

\[ \text{significance cutoff} = 1.96 \cdot s_{diff} = 1.96 \cdot \sqrt{2 \cdot (s_{1} \cdot \sqrt{1 - r_{xx´}})^2} \]

\(x_{2}\) = subject´s posttest score, \(x_{1}\) = subject´s pretest score, \(s_{diff}\) = standard error of difference between test scores, \(SE\) = standard error of measurement, \(s_{1}\) = standard deviation of test scores at pretest, \(r_{xx´}\) = reliability of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5_RCI_JT_Mean = (mean(PP_5.5$POST_Mean) - mean(PP_5.5$PRE_Mean)) / sqrt(2 * (sd(PP_5.5$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

PP_30.30_RCI_JT_Mean = (mean(PP_30.30$POST_Mean) - mean(PP_30.30$PRE_Mean)) / sqrt(2 * (sd(PP_30.30$PRE_Mean) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

PP_1.1_RCI_JT_Mean = (mean(PP_1.1$POST) - mean(PP_1.1$PRE)) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - 
  PP_5.5_Alpha)) ^ 2)

Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_5.5 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_30.30 = -2.282.
Durchschnittlicher RCI(JT) auf Stichproben-Ebene in PP_1.1 = -1.834.

RCI(JT) von einem Pre- zu einem Post-MZP (= original für jede Person individuell)

PP_1.1$RCI_JT = (PP_1.1$POST - PP_1.1$PRE) / sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)
RCI_JT_Cutoff = 1.96 * sqrt(2 * (sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

# Sollen RCI_JT %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_1.1 = PP_1.1 %>% 
#  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

x = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

y = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE, y$RCI_JT, xlab = "PP_1.1$PRE", ylab = "PP_1.1$RCI_JT", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation RCI_JT (je 1 MZP) mit PHQ-Baseline (Pre-MZP) = -0.451.
RCI(JT)-Cutoff für reliable Veränderung auf Gruppenebene (je 1 MZP) = 3.511.

Zwischenschritt vom RCI(JT) zum RCI(ind): Der Zähler in der Formel wird durch die Intervall-Differenz (5MZP Pre - 5MZP Post) ausgetauscht:

\[ RCI_{Zwischenstufe} = \frac{\overline{x_{2}} - \overline{x_{1}}} {s_{diff}} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores

PP_5.5$RCI_JT_ZwStufe = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / sqrt(2 * (sd(PP_5.5$PRE1_1) * sqrt(1 - PP_5.5_Alpha)) ^ 2)

# Sollen RCI_JT_ZwStufe %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

x = PP_5.5 %>% 
  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

y = PP_5.5 %>% 
  within(., {RCI_JT_ZwStufe[RCI_JT_ZwStufe %in% c(-Inf,Inf)] = NA})

scatter.hist(x$PRE_Mean, y$RCI_JT_ZwStufe, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_JT_ZwStufe", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Korrelation RCI_JT_ZwStufe (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.543.


1.8 Individual Reliable Change Index (ind)

1.8.1 RCI(ind) nur mit SD aus dem individuellen Pre-Intervall


\[ RCI_{ind,preSD} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D,pre}} \]

\[ SE_{D,pre} = \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D,pre} = 1.96 \cdot \sqrt{2 \cdot (s_{x} \cdot (1 - r_{xy})^2)} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D,pre}\) = standard error of difference between the test scores in the individual´s pre interval \(s_{x}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5

PP_5.5$SEd_pre = sqrt(2 * (PP_5.5$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_5.5$RCI_ind_preSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pre
PP_5.5$RCI_ind_preSD_Cutoff =  1.96 * PP_5.5$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_preSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.248.
Korrelation RCI(ind) nur mit Pre-SD (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.

PP_30.30

PP_30.30$SEd_pre = sqrt(2 * (PP_30.30$ind.pretestSD * sqrt(1 - PP_5.5_Alpha)) ^ 2)
PP_30.30$RCI_ind_preSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pre
PP_30.30$RCI_ind_preSD_Cutoff =  1.96 * PP_30.30$SEd_pre

# Sollen SEd_pre, RCI_ind_preSD und RCI_ind_preSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {SEd_pre[SEd_pre %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_preSD_Cutoff[RCI_ind_preSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_preSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_preSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.045.
Korrelation RCI(ind) nur mit Pre-SD (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.432.


1.8.2 RCI(ind) mit pooled SDs aus beiden individuellen Intervallen


\[ RCI_{ind} = \frac{\overline{x_{2}} - \overline{x_{1}}} {SE_{D}} \]

\[ SE_{D} = \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\[ \text{significance cutoff} = 1.96 \cdot SE_{D} = 1.96 \cdot \sqrt{(s_{x}^2 + s_{y}^2) \cdot (1 - r_{xy})} \]

\(\overline{x_{2}}\) = mean of subject´s posttest scores, \(\overline{x_{1}}\) = mean of subject´s pretest scores, \(SE_{D}\) = pooled standard error of difference between the test scores \(s_{x}\) = individual standard deviation of pretest time points, \(s_{y}\) = individual standard deviation of pretest time points, \(r_{xy}\) = reliability (internal consistency Cronbach´s \(\alpha\)) of the measure, \(\text{significance cutoff}\) = (absolute) cutoff score for reliable change (95%-criterion)

PP_5.5

PP_5.5$SEd_pooled = sqrt((PP_5.5$ind.pretestSD ^ 2 + PP_5.5$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_5.5$RCI_ind_pooledSD = (PP_5.5$POST_Mean - PP_5.5$PRE_Mean) / PP_5.5$SEd_pooled
PP_5.5$RCI_ind_pooledSD_Cutoff =  1.96 * PP_5.5$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_5.5 = PP_5.5 %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_5.5$PRE_Mean, PP_5.5$RCI_ind_pooledSD, xlab = "PP_5.5$PRE_Mean", ylab = "PP_5.5$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_5.5 = 2.641.
Korrelation RCI(ind) mit pooled SDs (je 5 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.

PP_30.30

PP_30.30$SEd_pooled = sqrt((PP_30.30$ind.pretestSD ^ 2 + PP_30.30$ind.posttestSD ^ 2) * (1 - PP_5.5_Alpha))
PP_30.30$RCI_ind_pooledSD = (PP_30.30$POST_Mean - PP_30.30$PRE_Mean) / PP_30.30$SEd_pooled
PP_30.30$RCI_ind_pooledSD_Cutoff =  1.96 * PP_30.30$SEd_pooled

# Sollen SEd_pooled, RCI_ind_pooledSD und RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf) ein-/ausgeschlossen werden?
#PP_30.30 = PP_30.30 %>% 
#  within(., {SEd_pooled[SEd_pooled %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA
#               RCI_ind_pooledSD_Cutoff[RCI_ind_pooledSD_Cutoff %in% c(-Inf,Inf)] = NA})

scatter.hist(PP_30.30$PRE_Mean, PP_30.30$RCI_ind_pooledSD, xlab = "PP_30.30$PRE_Mean", ylab = "PP_30.30$RCI_ind_pooledSD", ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

Durchschnittlicher RCI(ind)-Cutoff für reliable Veränderung in PP_30.30 = 2.403.
Korrelation RCI(ind) mit pooled SDs (je 30 MZP) mit PHQ-Baseline (Pre-Intervall-Mean) = -0.418.


1.9 Vergleich RCI(JT) - RCI(ind)

Vergleich des RCI(JT) in der Stichprobe mit je 1 MZP mit anderen RCIs (ind) in Intervall-Daten (je 5 MZP und je 30 MZP)

x = PP_5.5 %>% 
  within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
         RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})

y = PP_30.30 %>% 
  within(., {RCI_ind_preSD[RCI_ind_preSD %in% c(-Inf,Inf)] = NA
         RCI_ind_pooledSD[RCI_ind_pooledSD %in% c(-Inf,Inf)] = NA})

z = PP_1.1 %>% 
  within(., {RCI_JT[RCI_JT %in% c(-Inf,Inf)] = NA})

scatter.hist(x$RCI_ind_preSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse =  FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(y$RCI_ind_preSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_preSD", ylab = "PP_1.1$RCI_JT", ellipse =  FALSE, grid = TRUE, col = c("dodgerblue",  "darkorange"))

scatter.hist(x$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_5.5$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT",  ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))

scatter.hist(y$RCI_ind_pooledSD, z$RCI_JT, xlab = "PP_30.30$RCI_ind_pooledSD", ylab = "PP_1.1$RCI_JT",  ellipse = FALSE, grid = TRUE, col = c("dodgerblue", "darkorange"))


1.10 RCI-Klassifikationen

RCI_Int = tibble(RCI = c("RCI < -1,96","-1,96 <= RCI <= 1,96","RCI > 1,96"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("reliable Verbesserung","keine reliable Veränderung","reliable Verschlechterung"))

PP_5.5: RCI(ind) nur mit Pre-SDs

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    RCI_ind_preSD < -1.96 ~ -1,
    RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_preSD
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_preSD_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 4987 60.62
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 2617 31.81
RCI > 1,96 1 reliable Verschlechterung 622 7.56

PP_5.5: RCI(ind) mit pooled SDs

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    RCI_ind_pooledSD < -1.96 ~ -1,
    RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_pooledSD
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_pooledSD_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 4633 56.32
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 3192 38.80
RCI > 1,96 1 reliable Verschlechterung 401 4.87

PP_30.30: RCI(ind) nur mit Pre-SDs

PP_30.30 = PP_30.30 %>% 
  mutate(RCI_ind_preSD_klass = case_when(
    RCI_ind_preSD < -1.96 ~ -1,
    RCI_ind_preSD >= -1.96 & RCI_ind_preSD < 1.96 ~ 0,
    RCI_ind_preSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_preSD
  )
)

temp = PP_30.30 %>% 
  dplyr::count(RCI_ind_preSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_preSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_preSD_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 5160 62.73
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 2385 28.99
RCI > 1,96 1 reliable Verschlechterung 681 8.28

PP_30.30: RCI(ind) mit pooled SDs

PP_30.30 = PP_30.30 %>% 
  mutate(RCI_ind_pooledSD_klass = case_when(
    RCI_ind_pooledSD < -1.96 ~ -1,
    RCI_ind_pooledSD >= -1.96 & RCI_ind_pooledSD < 1.96 ~ 0,
    RCI_ind_pooledSD > 1.96 ~ 1,
    TRUE ~ RCI_ind_pooledSD
  )
)

temp = PP_30.30 %>% 
  dplyr::count(RCI_ind_pooledSD_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_ind_pooledSD_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_ind_pooledSD_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 4808 58.45
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 2959 35.97
RCI > 1,96 1 reliable Verschlechterung 459 5.58

PP_5.5: RCI(JT)-Zwischenstufe mit Pre-Mean - Post-Mean im Zähler.

PP_5.5 = PP_5.5 %>% 
  mutate(RCI_JT_ZwStufe_klass = case_when(
    RCI_JT_ZwStufe < -1.96 ~ -1,
    RCI_JT_ZwStufe >= -1.96 & RCI_JT_ZwStufe < 1.96 ~ 0,
    RCI_JT_ZwStufe > 1.96 ~ 1,
    TRUE ~ RCI_JT_ZwStufe
  )
)

temp = PP_5.5 %>% 
  dplyr::count(RCI_JT_ZwStufe_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_JT_ZwStufe_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_JT_ZwStufe_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 3951 48.03
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 4007 48.71
RCI > 1,96 1 reliable Verschlechterung 268 3.26

PP_1.1: RCI(JT)

PP_1.1 = PP_1.1 %>% 
  mutate(RCI_JT_klass = case_when(
    RCI_JT < -1.96 ~ -1,
    RCI_JT >= -1.96 & RCI_JT < 1.96 ~ 0,
    RCI_JT > 1.96 ~ 1,
    TRUE ~ RCI_JT
  )
)

temp = PP_1.1 %>% 
  dplyr::count(RCI_JT_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

RCI_Int %>%
  dplyr::rename(RCI_JT_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
RCI RCI_JT_klass Interpretation n Percentage
RCI < -1,96 -1 reliable Verbesserung 3776 45.90
-1,96 <= RCI <= 1,96 0 keine reliable Veränderung 4144 50.38
RCI > 1,96 1 reliable Verschlechterung 306 3.72

1.11 Edwards-Nunnally-Methode (EN) nach Speer (1992)


\[ \bigl[ r_{xx} (X_{pre} - M_{pre}) + M_{pre} \bigr] \pm 2 \cdot S_{pre} \cdot \sqrt{1 - r_{xx}} \]

\(r_{xx}\) = reliability of the measure, \(X_{pre}\) = individual´s raw score at pre-treatment, \(M_{pre}\) = mean of the sample at pre-treatment, \(S_{pre}\) = standard deviation of the sample at pre-treatment

Interpretation der Post-Ausprägung nach EN-Intervall-Methode

EN_Int = tibble(EN = c("PHQ POST < [EN-Intervall]","PHQ POST im [EN-Intervall]","PHQ POST > [EN-Intervall]"),
                Klassifikation = c(-1,0,1), Interpretation = c("signifikante Verbesserung",
                        "keine signifikante Veränderung","signifikante Verschlechterung"))

EN-Intervalle in PP_5.5

PP_5.5$EN_min = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) - 2 *
  mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_5.5$EN_max = (PP_5.5_Alpha * (PP_5.5$PRE_Mean - mean(PP_5.5$PRE_Mean)) + mean(PP_5.5$PRE_Mean)) + 2 *
  mean(PP_5.5$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_5.5 = PP_5.5 %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = PP_5.5 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 5554 67.52
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 1953 23.74
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 719 8.74

EN-Intervalle in PP_30.30

PP_30.30$EN_min = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) - 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_30.30$EN_max = (PP_5.5_Alpha * (PP_30.30$PRE_Mean - mean(PP_30.30$PRE_Mean)) + mean(PP_30.30$PRE_Mean)) + 2 * mean(PP_30.30$ind.pretestSD) * sqrt(1 - PP_5.5_Alpha)

PP_30.30 = PP_30.30 %>% 
  mutate(EN_klass = case_when(
    POST_Mean > EN_max ~ 1,
    POST_Mean < EN_max & POST_Mean > EN_min ~ 0,
    POST_Mean < EN_min ~ -1,
    TRUE ~ POST_Mean
  )
)

temp = PP_30.30 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 5665 68.87
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 1776 21.59
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 785 9.54

EN-Intervalle in PP_1.1

PP_1.1$EN_min = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) - 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)

PP_1.1$EN_max = (PP_5.5_Alpha * (PP_1.1$PRE - mean(PP_1.1$PRE)) + mean(PP_1.1$PRE)) + 2 * sd(PP_1.1$PRE) * sqrt(1 - PP_5.5_Alpha)

PP_1.1 = PP_1.1 %>% 
  mutate(EN_klass = case_when(
    POST > EN_max ~ 1,
    POST < EN_max & POST > EN_min ~ 0,
    POST < EN_min ~ -1,
    TRUE ~ as.numeric(POST)
  )
)

temp = PP_1.1 %>% 
  dplyr::count(EN_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

EN_Int %>%
  dplyr::rename(EN_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
EN EN_klass Interpretation n Percentage
PHQ POST < [EN-Intervall] -1 signifikante Verbesserung 4568 55.53
PHQ POST im [EN-Intervall] 0 keine signifikante Veränderung 3090 37.56
PHQ POST > [EN-Intervall] 1 signifikante Verschlechterung 568 6.90

1.12 Clinically Significant Improvement (CSI)

Clinically Significant Improvement (CSI) vom Pre- zum Post-Intervall

“The original validation study of the PHQ-9 defined clinically significant improvement as [a pre-treatment score >= 10 and] a post-treatment score of <= 9 combined with improvement of 50%.” (McMillan, Gilbody, & Richards, 2010)

CSI_Int = tibble(CSI = c("Pre-Score >= 10 & Post-Score <= 9 & PC >= 50", "every other combination", 
                         "Pre-Score <= 9 & Post-Score >= 10 & PC <= -50"),
                Klassifikation = c(-1,0,1),
                Interpretation = c("klinisch signifikante Verbesserung", "keine klinisch signifikante Veränderung", 
                                   "klinisch signifikante Verschlechterung"))

1.12.1 CSI in PP_5.5

PP_5.5 = PP_5.5 %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_5.5 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1738 21.13
every other combination 0 keine klinisch signifikante Veränderung 6306 76.66
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 182 2.21

1.12.2 CSI in PP_30.30

PP_30.30 = PP_30.30 %>% 
   mutate(CSI_klass = case_when(
     PRE_Mean >= 10 & POST_Mean <= 9 & Mean_PC >= 50 ~ -1,
     PRE_Mean <= 9 & POST_Mean >= 10 & Mean_PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_30.30 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1738 21.13
every other combination 0 keine klinisch signifikante Veränderung 6306 76.66
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 182 2.21

1.12.3 CSI in PP_1.1

PP_1.1 = PP_1.1 %>% 
   mutate(CSI_klass = case_when(
     PRE >= 10 & POST <= 9 & PC >= 50 ~ -1,
     PRE <= 9 & POST >= 10 & PC <= -50 ~ 1,
     TRUE ~ 0
   )
)

temp = PP_1.1 %>% 
  dplyr::count(CSI_klass) %>% 
  mutate(Percentage = round(((n / sum(n)) * 100), digits = 2))

CSI_Int %>%
  dplyr::rename(CSI_klass = Klassifikation) %>%
  full_join(., temp) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
CSI CSI_klass Interpretation n Percentage
Pre-Score >= 10 & Post-Score <= 9 & PC >= 50 -1 klinisch signifikante Verbesserung 1989 24.18
every other combination 0 keine klinisch signifikante Veränderung 6179 75.12
Pre-Score <= 9 & Post-Score >= 10 & PC <= -50 1 klinisch signifikante Verschlechterung 58 0.71

1.13 Individuelle Übereinstimmung der Klassifikationen

Übereinstimmung der Klassifikationen auf individueller Ebene zwischen PP_5.5, PP_30.30 und PP_1.1:

Interpretation von Cohen´s Kappa:

tibble(Cohen_Kappa = c("k < .20",".21 <= k < .40",".41 <= k < .60",".61 <= k < .80","k > .80"),
       Interpretation = c("poor","fair","moderate","good","very good")) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Cohen_Kappa Interpretation
k < .20 poor
.21 <= k < .40 fair
.41 <= k < .60 moderate
.61 <= k < .80 good
k > .80 very good

1.13.1 Klinische PHQ-9-Interpretation

Übereinstimmung zwischen den klinischen Interpretationen der PHQ-9-Werte für Pre- und Post-Intervalle (je 5 MZP und je 30 MZP) und für einzelne Pre- und Post-Messzeitpunkte (je 1 MZP):

# PRE
x = PP_5.5 %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass.5 = PRE_Mean_klass)

y = PP_30.30 %>% 
  select(ID, PRE_Mean_klass) %>% 
  dplyr::rename(PRE_klass.30 = PRE_Mean_klass)

z = PP_1.1 %>% 
  select(ID, PRE_klass) %>% 
  dplyr::rename(PRE_klass.1 = PRE_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("PRE_klass_5.5", "PRE_klass_30.30", "PRE_klass_1.1")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-PRE-Klassifikationen")

# POST
x = PP_5.5 %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass.5 = POST_Mean_klass)

y = PP_30.30 %>% 
  select(ID, POST_Mean_klass) %>% 
  dplyr::rename(POST_klass.30 = POST_Mean_klass)

z = PP_1.1 %>% 
  select(ID, POST_klass) %>% 
  dplyr::rename(POST_klass.1 = POST_klass)

temp = full_join(x, y, by = "ID") %>% 
  full_join(., z, by = "ID") %>% 
  select(-ID) %>% 
  mutate(across(.cols = everything(), as.factor))

### Cohen´s Kappa
rnames = c("POST_klass_5.5", "POST_klass_30.30", "POST_klass_1.1")

Agreement = matrix(ncol = 3, nrow = 3, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("temp$", names(temp[,i]))))
    y = eval(parse(text = paste0("temp$", names(temp[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.7, cex = 0.8, las = 2, 
     key = list(cex.axis=0.7), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der PHQ-POST-Klassifikationen")


1.13.2 Zusammenfassung der Klassifikations-Häufigkeiten

# einheitliche Kodierung von Verbesserung (-1), keiner Veränderung (0) und Verschlechterung (1):

x = PP_5.5 %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, RCI_JT_ZwStufe_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_5.5 = Mean_PC_klass, RCI_ind_preSD_5.5 = RCI_ind_preSD_klass, RCI_ind_pooledSD_5.5 = RCI_ind_pooledSD_klass,
         RCI_JT_ZwStufe_5.5 = RCI_JT_ZwStufe_klass, EN_5.5 = EN_klass, CSI_5.5 = CSI_klass) %>% 
  mutate(Mean_PC_5.5 = recode(Mean_PC_5.5, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

y = PP_30.30 %>% 
  select(ID, Mean_PC_klass, RCI_ind_preSD_klass, RCI_ind_pooledSD_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(Mean_PC_30.30 = Mean_PC_klass, RCI_ind_preSD_30.30 = RCI_ind_preSD_klass, 
         RCI_ind_pooledSD_30.30 = RCI_ind_pooledSD_klass, EN_30.30 = EN_klass, CSI_30.30 = CSI_klass) %>% 
  mutate(Mean_PC_30.30 = recode(Mean_PC_30.30, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

z = PP_1.1 %>% 
  select(ID, PC_klass, RCI_JT_klass, EN_klass, CSI_klass) %>% 
  dplyr::rename(PC_1.1 = PC_klass, RCI_JT_1.1 = RCI_JT_klass, 
         EN_1.1 = EN_klass, CSI_1.1 = CSI_klass) %>% 
  mutate(PC_1.1 = recode(PC_1.1, '-2' = 1L, '-1' = 0L, '0' = 0L, '1' = 0L, '2' = -1L))

PP_Class = full_join(x, y, by = "ID") %>% 
  full_join(., z, "ID") %>% 
  select(-ID) %>% 
  dplyr::mutate(across(.cols = everything(), as.factor))
#save(PP_Class, file = "cor_07_k20/PP_Class.RData")

rnames = names(PP_Class)

#view(dfSummary(PP_Class))
#dfSummary(PP_Class, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, tmp.img.dir = "/tmp")
#dfSummary(PP_Class)
print(dfSummary(PP_Class, varnumbers = FALSE, plain.ascii = FALSE, style = 'grid', graph.magnif = 0.75, valid.col = FALSE, na.col = FALSE, display.labels = FALSE, silent = FALSE, headers = FALSE, footnote = NA, tmp.img.dir = "/tmp"), method = 'render')

Data Frame Summary

PP_Class

Dimensions: 8226 x 15
Duplicates: 7890
Variable Stats / Values Freqs (% of Valid) Graph
Mean_PC_5.5 [factor] 1. -1 2. 0 3. 1
2560(31.1%)
5441(66.1%)
225(2.7%)
RCI_ind_preSD_5.5 [factor] 1. -1 2. 0 3. 1
4987(60.6%)
2617(31.8%)
622(7.6%)
RCI_ind_pooledSD_5.5 [factor] 1. -1 2. 0 3. 1
4633(56.3%)
3192(38.8%)
401(4.9%)
RCI_JT_ZwStufe_5.5 [factor] 1. -1 2. 0 3. 1
3951(48.0%)
4007(48.7%)
268(3.3%)
EN_5.5 [factor] 1. -1 2. 0 3. 1
5554(67.5%)
1953(23.7%)
719(8.7%)
CSI_5.5 [factor] 1. -1 2. 0 3. 1
1738(21.1%)
6306(76.7%)
182(2.2%)
Mean_PC_30.30 [factor] 1. -1 2. 0 3. 1
2560(31.1%)
5441(66.1%)
225(2.7%)
RCI_ind_preSD_30.30 [factor] 1. -1 2. 0 3. 1
5160(62.7%)
2385(29.0%)
681(8.3%)
RCI_ind_pooledSD_30.30 [factor] 1. -1 2. 0 3. 1
4808(58.5%)
2959(36.0%)
459(5.6%)
EN_30.30 [factor] 1. -1 2. 0 3. 1
5665(68.9%)
1776(21.6%)
785(9.5%)
CSI_30.30 [factor] 1. -1 2. 0 3. 1
1738(21.1%)
6306(76.7%)
182(2.2%)
PC_1.1 [factor] 1. -1 2. 0 3. 1
2933(35.7%)
5118(62.2%)
175(2.1%)
RCI_JT_1.1 [factor] 1. -1 2. 0 3. 1
3776(45.9%)
4144(50.4%)
306(3.7%)
EN_1.1 [factor] 1. -1 2. 0 3. 1
4568(55.5%)
3090(37.6%)
568(6.9%)
CSI_1.1 [factor] 1. -1 2. 0 3. 1
1989(24.2%)
6179(75.1%)
58(0.7%)

Generated by summarytools 0.9.6 (R version 4.0.2)
2020-12-13


1.13.3 Übereinstimmung der Klassifikations-Häufigkeiten

Gesamt-Übereinstimmung

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Agreement[i,j] = CohenKappa(x = x, y = y)
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa) der Klassifikationen")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = Agree(cbind(x, y))[1]
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung der Klassifikationen")

Übereinstimmung nur für Verbesserung (-1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>% 
      dplyr::recode_factor(., '-1' = -1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verbesserung (-1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == -1L & y == -1L)) / 
      length(which(x == -1L | y == -1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verbesserung (-1)")

Übereinstimmung nur für Verschlechterung (1)

### Cohen´s Kappa
Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Agreement)) {
  for (j in 1:ncol(Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i])))) %>% 
      recode_factor(., '1' = 1L)
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j])))) %>% 
      recode_factor(., '1' = 1L)
    
    Agreement[i,j] = CohenKappa(x = x, y = y, useNA = "ifany")
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Agreement, col = heat.colors(n=5, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.21, 0.41, 0.61, 0.81, 1));
  title(main = "Übereinstimmung (Cohen´s Kappa): Verschlechterung (1)")

### Prozentuale Übereinstimmung
Percentage_Agreement = matrix(ncol = 15, nrow = 15, dimnames = list(rnames, rnames))

for (i in 1:nrow(Percentage_Agreement)) {
  for (j in 1:ncol(Percentage_Agreement)) {
    x = eval(parse(text = paste0("PP_Class$", names(PP_Class[,i]))))
    y = eval(parse(text = paste0("PP_Class$", names(PP_Class[,j]))))
    
    Percentage_Agreement[i,j] = length(which(x == 1L & y == 1L)) / 
      length(which(x == 1L | y == 1L))
  }
}

# mit plot.matrix::...
par(mar = c(5.1, 4.1, 4.1, 4.1)) # default c(5.1, 4.1, 4.1, 2.1)
plot(Percentage_Agreement, col = heat.colors(n=4, rev=TRUE), fmt.cell = "%.2f", cex.axis = 0.5, cex = 0.7, las = 2, 
     key = list(cex.axis=0.6), ann = FALSE, breaks = c(0, 0.26, 0.51, 0.76, 1));
  title(main = "Prozentuale Übereinstimmung: Verschlechterung (1)")


1.14 Sensitivität und Spezifität der Klassifikationsmethoden

Diagnostische Sensitivität und Spezifität einer “neuen” Testmethode im Vergleich zu einer “Goldstandard”-Testmethode:
Sensitivität = Wahrscheinlichkeit für ein richtig-positives Testergebnis
Spezifität = Wahrscheinlichkeit für ein richtig-negatives Testergebnis

\[ Sensitivity = Recall = TPR = \frac{\sum{\text{True Positives}}} {\sum{\text{True Positives}} + \sum{\text{False Negatives}}} = \frac{tp}{tp + fn} \]

\[ Specificity = Selectivity = TNR = \frac{\sum{\text{True Negatives}}} {\sum{\text{True Negatives}} + \sum{\text{False Positives}}} = \frac{tn}{tn + fp} \]

\[ \textit{Geometric Mean of Sensitivity and Specificity} = \sqrt{Sensitivity \cdot Specificity} \]

\[ Sensitivity_{\textit{class-weighted average}} = Recall_{wgt} = \rho_{wgt} = \sum_{k=1}^{c} \frac{n_k}{n} \rho_k = \frac{1}{n} \sum_{k=1}^{c} tp^{(k)} = \frac{tp^{(deteriorated)}} {tp^{(deteriorated)} + fn^{(deteriorated)}} + \frac{tp^{(\textit{not changed})}} {tp^{(\textit{not changed})} + fn^{(\textit{not changed})}} + \frac{tp^{(improved)}} {tp^{(improved)} + fn^{(improved)}} \]

\(c\) = number of classes (i.e. 3: deteriorated; not changed; improved); \(n_k\) = number of cases belonging to class \(k\), with \(k=1,...,c\); \(n\) = total number of cases, with \(n = \sum_{k=1}^{c} n_k\)

Sensitivität & Spezifität gegenüber Veränderung:
Evaluation der Veränderungs-Klassifikationen der Klassifikationsmethoden im Vergleich zur klinischen Signifikanz CSI (je 30 MZP) als “Goldstandard”:

ClassEval = list()
for (i in 1:ncol(PP_Class)) {
  x = eval(parse(text = paste0("PP_Class$", colnames(PP_Class[,i]))))
  cm = confusionMatrix(x, reference = PP_Class$CSI_30.30, 
                       dnn = c(paste0("PP_Class$", names(PP_Class[,i])), "CSI 30.30"), mode = "everything")
  cm$agreement = cm$overall[c("Accuracy","Kappa")]
  cm$senspez = cm$byClass %>% 
    as_tibble() %>% 
    select(Sensitivity, Specificity)
  
  cm$senspez_cwa = cm$senspez %>% 
    summarise(across(.cols = everything(), .fns = geometric.mean, .names = "{.col}_cwa")) %>% 
    mutate(GMean_SenSpez = geometric.mean(c(Sensitivity_cwa, Specificity_cwa)))
  
  ClassEval[[paste0(names(PP_Class[,i]))]] = cm[c("table","agreement","senspez","senspez_cwa")]
}

#save(ClassEval, file = "cor_07_k20/PP_ClassEval.RData")
#load("cor_07_k20/PP_Class.RData")

SenSpezSumm = tibble(Frequency = as.factor(c(rep("5.5", 6), rep("30.30", 5), rep("1.1", 4))),
                 Method = colnames(PP_Class),
                 Sens_imp = as.numeric(NA),
                 Sens_not = as.numeric(NA),
                 Sens_det = as.numeric(NA),
                 Spec_imp = as.numeric(NA),
                 Spec_not = as.numeric(NA),
                 Spec_det = as.numeric(NA),
                 Sensitivity_cwa = as.numeric(NA),
                 Specificity_cwa = as.numeric(NA),
                 SenSpec_mean = as.numeric(NA),
                 Accuracy_PercAgree = as.numeric(NA),
                 Kappa = as.numeric(NA))

for (i in 1:nrow(SenSpezSumm)) {
  SenSpezSumm[i,"Sens_imp"] = ClassEval[[i]][["senspez"]]$Sensitivity[1]
  SenSpezSumm[i,"Sens_not"] = ClassEval[[i]][["senspez"]]$Sensitivity[2]
  SenSpezSumm[i,"Sens_det"] = ClassEval[[i]][["senspez"]]$Sensitivity[3]
  
  SenSpezSumm[i,"Spec_imp"] = ClassEval[[i]][["senspez"]]$Specificity[1]
  SenSpezSumm[i,"Spec_not"] = ClassEval[[i]][["senspez"]]$Specificity[2]
  SenSpezSumm[i,"Spec_det"] = ClassEval[[i]][["senspez"]]$Specificity[3]
  
  SenSpezSumm[i,"Sensitivity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Sensitivity_cwa
  SenSpezSumm[i,"Specificity_cwa"] = ClassEval[[i]][["senspez_cwa"]]$Specificity_cwa
  SenSpezSumm[i,"SenSpec_mean"] = ClassEval[[i]][["senspez_cwa"]]$GMean_SenSpez
  
  SenSpezSumm[i,"Accuracy_PercAgree"] = ClassEval[[i]][["agreement"]][[1]]
  SenSpezSumm[i,"Kappa"] = ClassEval[[i]][["agreement"]][[2]]
}

#save(SenSpezSumm, file = "cor_07_k20/PP_SenSpezSumm.RData")
#load("cor_07_k20/PP_SenSpezSumm.RData")

SenSpezSumm %>% 
  mutate(across(.cols = where(is.numeric), .fns = round, digits = 2)) %>% 
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), full_width = FALSE)
Frequency Method Sens_imp Sens_not Sens_det Spec_imp Spec_not Spec_det Sensitivity_cwa Specificity_cwa SenSpec_mean Accuracy_PercAgree Kappa
5.5 Mean_PC_5.5 1.00 0.86 1.00 0.87 1.00 0.99 0.95 0.95 0.95 0.89 0.75
5.5 RCI_ind_preSD_5.5 1.00 0.41 0.98 0.50 1.00 0.94 0.74 0.78 0.76 0.55 0.28
5.5 RCI_ind_pooledSD_5.5 1.00 0.50 0.93 0.55 0.99 0.97 0.78 0.81 0.79 0.62 0.35
5.5 RCI_JT_ZwStufe_5.5 1.00 0.63 0.97 0.66 1.00 0.99 0.85 0.87 0.86 0.72 0.46
5.5 EN_5.5 1.00 0.31 1.00 0.41 1.00 0.93 0.68 0.73 0.70 0.47 0.21
5.5 CSI_5.5 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00
30.30 Mean_PC_30.30 1.00 0.86 1.00 0.87 1.00 0.99 0.95 0.95 0.95 0.89 0.75
30.30 RCI_ind_preSD_30.30 1.00 0.38 0.99 0.47 1.00 0.94 0.72 0.76 0.74 0.52 0.26
30.30 RCI_ind_pooledSD_30.30 1.00 0.47 0.97 0.53 1.00 0.96 0.77 0.80 0.78 0.59 0.32
30.30 EN_30.30 1.00 0.28 1.00 0.39 1.00 0.93 0.66 0.71 0.68 0.45 0.20
30.30 CSI_30.30 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00 1.00
1.1 PC_1.1 0.71 0.71 0.09 0.74 0.66 0.98 0.35 0.78 0.53 0.69 0.32
1.1 RCI_JT_1.1 0.85 0.59 0.13 0.65 0.79 0.96 0.40 0.79 0.56 0.64 0.30
1.1 EN_1.1 0.90 0.44 0.20 0.54 0.84 0.93 0.43 0.75 0.57 0.54 0.22
1.1 CSI_1.1 0.61 0.85 0.05 0.86 0.56 0.99 0.31 0.78 0.49 0.78 0.41
graphics::barplot(SenSpezSumm$Sensitivity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Sensitivity to Change (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Specificity_cwa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7,
                  horiz = TRUE, main = "Specificity to Change (Reference = CSI_30.30)")

graphics::barplot(SenSpezSumm$SenSpec_mean ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Mean of Sensitivity and Specificity (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Accuracy_PercAgree ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Accuracy = Percentage Agreement (Reference = CSI_30.30)")
graphics::barplot(SenSpezSumm$Kappa ~ SenSpezSumm$Method, col = "dodgerblue", las = 2, cex.names = 0.7, 
                  horiz = TRUE, main = "Agreement: Cohen´s Kappa (Reference = CSI_30.30)")

1.15 Jackknife-Methode zum Resampling von Messzeitpunkten

Statt wenige zufällige MZP-Kombinationen zu ziehen und diese dann mit den “wahren” Schätzwerten und Klassifikationen (= berechnet anhand der gesamten Intervalle mit je 30 MZP) zu vergleichen, sollen die empirische Verteilung der Parameter und somit der Schätzfehler über Resampling-Methoden wie Jackknife-Verfahren und Bootstrapping berechnet werden.

Percentage Change (PC)

###### PP_5.5
n = 5

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  PP_5.5[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

PP_5.5_Mean_PC_JK = PP_5.5 %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_5.5_Mean_PC_JK, file = "Jackknife/PP_5.5_Mean_PC_JK_k20.RData")

###### PP_30.30
n = 30

Mean_PC = function(x, ID_df) {(1-((mean(ID_df[x,2])) / (mean(ID_df[x,1])))) * 100}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"Mean_PC_jse"] = jackknife(1:n, Mean_PC, df)$jack.se
  PP_30.30[i,"Mean_PC_jbias"] = jackknife(1:n, Mean_PC, df)$jack.bias
  message(i)
}

PP_30.30_Mean_PC_JK = PP_30.30 %>% 
  select(ID, Mean_PC_jse, Mean_PC_jbias)
save(PP_30.30_Mean_PC_JK, file = "Jackknife/PP_30.30_Mean_PC_JK_k20.RData")
load("Jackknife/PP_5.5_Mean_PC_JK_k20.RData")
load("Jackknife/PP_30.30_Mean_PC_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_Mean_PC_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_Mean_PC_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$Mean_PC_jse, PP_30.30$Mean_PC_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of Mean Percentage Change", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$Mean_PC_jbias, PP_30.30$Mean_PC_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$Mean_PC_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of Mean Percentage Change", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")

RCI(ind) nur mit SD aus dem individuellen Pre-Intervall

###### PP_5.5
n = 5

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  PP_5.5[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

PP_5.5_RCI_ind_preSD_JK = PP_5.5 %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_5.5_RCI_ind_preSD_JK, file = "Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")

###### PP_30.30
n = 30

RCI_ind_preSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt(2 * (sd(ID_df[x,1]) * sqrt(1 - PP_5.5_Alpha))^2)}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"RCI_ind_preSD_jse"] = jackknife(1:n, RCI_ind_preSD, df)$jack.se
  PP_30.30[i,"RCI_ind_preSD_jbias"] = jackknife(1:n, RCI_ind_preSD, df)$jack.bias
  message(i)
}

PP_30.30_RCI_ind_preSD_JK = PP_30.30 %>% 
  select(ID, RCI_ind_preSD_jse, RCI_ind_preSD_jbias)
save(PP_30.30_RCI_ind_preSD_JK, file = "Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/PP_5.5_RCI_ind_preSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_preSD_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_preSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_preSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_preSD_jse, PP_30.30$RCI_ind_preSD_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of RCI(ind) With Pre-SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_preSD_jbias, PP_30.30$RCI_ind_preSD_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_preSD_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of RCI(ind) With Pre-SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")

RCI(ind) mit pooled SDs aus beiden individuellen Intervallen

###### PP_5.5
n = 5

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}

for (i in 1:nrow(PP_5.5)) {
  df = data.frame(PRE = as.numeric(PP_5.5[i,pre_5mzp]), POST = as.numeric(PP_5.5[i,post_5mzp]))
  
  PP_5.5[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  PP_5.5[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

PP_5.5_RCI_ind_pooledSD_JK = PP_5.5 %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_5.5_RCI_ind_pooledSD_JK, file = "Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")

###### PP_30.30
n = 30

RCI_ind_pooledSD = function(x, ID_df) {(mean(ID_df[x,2]) - mean(ID_df[x,1])) / 
    sqrt((sd(ID_df[x,1])^ 2 + sd(ID_df[x,2])^ 2) * (1 - PP_5.5_Alpha))}

for (i in 1:nrow(PP_30.30)) {
  df = data.frame(PRE = as.numeric(PP_30.30[i,pre_30mzp]), POST = as.numeric(PP_30.30[i,post_30mzp]))
  
  PP_30.30[i,"RCI_ind_pooledSD_jse"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.se
  PP_30.30[i,"RCI_ind_pooledSD_jbias"] = jackknife(1:n, RCI_ind_pooledSD, df)$jack.bias
  message(i)
}

PP_30.30_RCI_ind_pooledSD_JK = PP_30.30 %>% 
  select(ID, RCI_ind_pooledSD_jse, RCI_ind_pooledSD_jbias)
save(PP_30.30_RCI_ind_pooledSD_JK, file = "Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/PP_5.5_RCI_ind_pooledSD_JK_k20.RData")
load("Jackknife/PP_30.30_RCI_ind_pooledSD_JK_k20.RData")

PP_5.5 = full_join(PP_5.5, PP_5.5_RCI_ind_pooledSD_JK, by = "ID")
PP_30.30 = full_join(PP_30.30, PP_30.30_RCI_ind_pooledSD_JK, by = "ID")

temp = tibble(Jackknife_SE = c(PP_5.5$RCI_ind_pooledSD_jse, PP_30.30$RCI_ind_pooledSD_jse),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jse)))

temp %>%
  ggplot(aes(x = Jackknife_SE, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife SE of RCI(ind) With Pooled SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_SE)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife SEs") +
#  xlab("Dataset")


temp = tibble(Jackknife_Bias = c(PP_5.5$RCI_ind_pooledSD_jbias, PP_30.30$RCI_ind_pooledSD_jbias),
              Datasets = rep(c("PP_5.5", "PP_30.30"), each = length(PP_5.5$RCI_ind_pooledSD_jbias)))

temp %>%
  ggplot(aes(x = Jackknife_Bias, fill = Datasets)) +
    geom_histogram(alpha = 0.2, binwidth = 1, position = "identity") +
    labs(x = "Jackknife Bias of RCI(ind) With Pooled SDs", y = "Cases")

#ggplot(temp, aes(x = Datasets, y = Jackknife_Bias)) + 
#  geom_boxplot(na.rm = TRUE) + 
#  ggtitle("Jackknife Biases") +
#  xlab("Dataset")